summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2008-01-21 12:21:36 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2008-01-21 12:21:36 +0000
commite4e4edd07f3c87ab2cee948e63a70ba233547512 (patch)
tree0b96ae7d1981c21b76dcd1e3dfac00394b8c8832
parent462e2d2731c8090524462bcb34bc4f9c6bd27035 (diff)
Also updated API stuff in Perl5_lib-TL_ins
git-svn-id: svn://tug.org/texlive/trunk@6348 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API.pm745
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API.pm.orig741
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Callback.pm174
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Struct.pm532
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Test.pm120
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Type.pm446
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/API.bs0
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/API.dllbin0 -> 20480 bytes
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/Callback/Callback.bs0
-rw-r--r--Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/Callback/Callback.dllbin0 -> 16384 bytes
-rwxr-xr-xMaster/wingoo-demo.bat4
-rw-r--r--Master/wingoo-demo.pl24
12 files changed, 2780 insertions, 6 deletions
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API.pm
new file mode 100644
index 00000000000..e1bac5cda48
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API.pm
@@ -0,0 +1,745 @@
+package Win32::API;
+
+# See the bottom of this file for the POD documentation. Search for the
+# string '=head'.
+
+#######################################################################
+#
+# Win32::API - Perl Win32 API Import Facility
+#
+# Version: 0.47
+# Date: 12 Nov 2007
+# Author: Aldo Calpini <dada@perl.it>
+# Maintainer: Cosimo Streppone <cosimo@cpan.org>
+#
+# Changes for gcc/cygwin: Daniel Risacher <magnus@alum.mit.edu>
+# ported from 0.41 based on Daniel's patch by Reini Urban <rurban@x-ray.at>
+#
+# $Id: API.pm,v 1.0 2001/10/30 13:57:31 dada Exp $
+#
+#######################################################################
+
+require Exporter; # to export the constants to the main:: space
+require DynaLoader; # to dynuhlode the module.
+@ISA = qw( Exporter DynaLoader );
+
+use vars qw( $DEBUG );
+$DEBUG = 0;
+
+sub DEBUG {
+ if ($Win32::API::DEBUG) {
+ printf @_ if @_ or return 1;
+ } else {
+ return 0;
+ }
+}
+
+use Win32::API::Type;
+use Win32::API::Struct;
+BEGIN {
+ if ($^O eq 'cygwin') {
+ require File::Basename;
+ }
+}
+
+#######################################################################
+# STATIC OBJECT PROPERTIES
+#
+$VERSION = '0.47';
+
+#### some package-global hash to
+#### keep track of the imported
+#### libraries and procedures
+my %Libraries = ();
+my %Procedures = ();
+
+
+#######################################################################
+# dynamically load in the API extension module.
+#
+bootstrap Win32::API;
+
+#######################################################################
+# PUBLIC METHODS
+#
+sub new {
+ my($class, $dll, $proc, $in, $out) = @_;
+ my $hdll;
+ my $self = {};
+
+ if ($^O eq 'cygwin' and $dll ne File::Basename::basename($dll)) {
+ # need to convert $dll to win32 path
+ # isn't there an API for this?
+ my $newdll = `cygpath -w "$dll"`;
+ chomp $newdll;
+ DEBUG "(PM)new: converted '$dll' to\n '$newdll'\n";
+ $dll = $newdll;
+ }
+
+ #### avoid loading a library more than once
+ if(exists($Libraries{$dll})) {
+ DEBUG "Win32::API::new: Library '$dll' already loaded, handle=$Libraries{$dll}\n";
+ $hdll = $Libraries{$dll};
+ } else {
+ DEBUG "Win32::API::new: Loading library '$dll'\n";
+ $hdll = Win32::API::LoadLibrary($dll);
+# $Libraries{$dll} = $hdll;
+ }
+
+ #### if the dll can't be loaded, set $! to Win32's GetLastError()
+ if(!$hdll) {
+ $! = Win32::GetLastError();
+ DEBUG "FAILED Loading library '$dll': $!\n";
+ delete $Libraries{$dll};
+ return undef;
+ }
+
+ #### determine if we have a prototype or not
+ if( (not defined $in) and (not defined $out) ) {
+ ($proc, $self->{in}, $self->{intypes}, $self->{out}) = parse_prototype( $proc );
+ return undef unless $proc;
+ $self->{proto} = 1;
+ } else {
+ $self->{in} = [];
+ if(ref($in) eq 'ARRAY') {
+ foreach (@$in) {
+ push(@{ $self->{in} }, type_to_num($_));
+ }
+ } else {
+ my @in = split '', $in;
+ foreach (@in) {
+ push(@{ $self->{in} }, type_to_num($_));
+ }
+ }
+ $self->{out} = type_to_num($out);
+ }
+
+ #### first try to import the function of given name...
+ my $hproc = Win32::API::GetProcAddress($hdll, $proc);
+
+ #### ...then try appending either A or W (for ASCII or Unicode)
+ if(!$hproc) {
+ my $tproc = $proc;
+ $tproc .= (IsUnicode() ? "W" : "A");
+ # print "Win32::API::new: procedure not found, trying '$tproc'...\n";
+ $hproc = Win32::API::GetProcAddress($hdll, $tproc);
+ }
+
+ #### ...if all that fails, set $! accordingly
+ if(!$hproc) {
+ $! = Win32::GetLastError();
+ DEBUG "FAILED GetProcAddress for Proc '$proc': $!\n";
+ return undef;
+ }
+ DEBUG "GetProcAddress('$proc') = '$hproc'\n";
+
+ #### ok, let's stuff the object
+ $self->{procname} = $proc;
+ $self->{dll} = $hdll;
+ $self->{dllname} = $dll;
+ $self->{proc} = $hproc;
+
+ #### keep track of the imported function
+ $Libraries{$dll} = $hdll;
+ $Procedures{$dll}++;
+
+ DEBUG "Object blessed!\n";
+
+ #### cast the spell
+ bless($self, $class);
+ return $self;
+}
+
+sub Import {
+ my($class, $dll, $proc, $in, $out) = @_;
+ $Imported{"$dll:$proc"} = Win32::API->new($dll, $proc, $in, $out) or return 0;
+ my $P = (caller)[0];
+ eval qq(
+ sub ${P}::$Imported{"$dll:$proc"}->{procname} { \$Win32::API::Imported{"$dll:$proc"}->Call(\@_); }
+ );
+ return $@ ? 0 : 1;
+}
+
+
+#######################################################################
+# PRIVATE METHODS
+#
+sub DESTROY {
+ my($self) = @_;
+
+ #### decrease this library's procedures reference count
+ $Procedures{$self->{dllname}}--;
+
+ #### once it reaches 0, free it
+ if($Procedures{$self->{dllname}} == 0) {
+ DEBUG "Win32::API::DESTROY: Freeing library '$self->{dllname}'\n";
+ Win32::API::FreeLibrary($Libraries{$self->{dllname}});
+ delete($Libraries{$self->{dllname}});
+ }
+}
+
+sub type_to_num {
+ my $type = shift;
+ my $out = shift;
+ my $num;
+
+ if( $type eq 'N'
+ or $type eq 'n'
+ or $type eq 'l'
+ or $type eq 'L'
+ ) {
+ $num = 1;
+ } elsif($type eq 'P'
+ or $type eq 'p'
+ ) {
+ $num = 2;
+ } elsif($type eq 'I'
+ or $type eq 'i'
+ ) {
+ $num = 3;
+ } elsif($type eq 'f'
+ or $type eq 'F'
+ ) {
+ $num = 4;
+ } elsif($type eq 'D'
+ or $type eq 'd'
+ ) {
+ $num = 5;
+ } elsif($type eq 'c'
+ or $type eq 'C'
+ ) {
+ $num = 6;
+ } else {
+ $num = 0;
+ }
+ unless(defined $out) {
+ if( $type eq 's'
+ or $type eq 'S'
+ ) {
+ $num = 51;
+ } elsif($type eq 'b'
+ or $type eq 'B'
+ ) {
+ $num = 22;
+ } elsif($type eq 'k'
+ or $type eq 'K'
+ ) {
+ $num = 101;
+ }
+ }
+ return $num;
+}
+
+sub parse_prototype {
+ my($proto) = @_;
+
+ my @in_params = ();
+ my @in_types = ();
+ if($proto =~ /^\s*(\S+)\s+(\S+)\s*\(([^\)]*)\)/) {
+ my $ret = $1;
+ my $proc = $2;
+ my $params = $3;
+
+ $params =~ s/^\s+//;
+ $params =~ s/\s+$//;
+
+ DEBUG "(PM)parse_prototype: got PROC '%s'\n", $proc;
+ DEBUG "(PM)parse_prototype: got PARAMS '%s'\n", $params;
+
+ foreach my $param (split(/\s*,\s*/, $params)) {
+ my($type, $name);
+ if($param =~ /(\S+)\s+(\S+)/) {
+ ($type, $name) = ($1, $2);
+ }
+
+ if(Win32::API::Type::is_known($type)) {
+ if(Win32::API::Type::is_pointer($type)) {
+ DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
+ $type,
+ Win32::API::Type->packing( $type ),
+ type_to_num('P');
+ push(@in_params, type_to_num('P'));
+ } else {
+ DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
+ $type,
+ Win32::API::Type->packing( $type ),
+ type_to_num( Win32::API::Type->packing( $type ) );
+ push(@in_params, type_to_num( Win32::API::Type->packing( $type ) ));
+ }
+ } elsif( Win32::API::Struct::is_known( $type ) ) {
+ DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
+ $type, 'S', type_to_num('S');
+ push(@in_params, type_to_num('S'));
+ } else {
+ warn "Win32::API::parse_prototype: WARNING unknown parameter type '$type'";
+ push(@in_params, type_to_num('I'));
+ }
+ push(@in_types, $type);
+
+ }
+ DEBUG "parse_prototype: IN=[ @in_params ]\n";
+
+
+
+ if(Win32::API::Type::is_known($ret)) {
+ if(Win32::API::Type::is_pointer($ret)) {
+ DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n",
+ $ret,
+ Win32::API::Type->packing( $ret ),
+ type_to_num('P');
+ return ( $proc, \@in_params, \@in_types, type_to_num('P') );
+ } else {
+ DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n",
+ $ret,
+ Win32::API::Type->packing( $ret ),
+ type_to_num( Win32::API::Type->packing( $ret ) );
+ return ( $proc, \@in_params, \@in_types, type_to_num(Win32::API::Type->packing($ret)) );
+ }
+ } else {
+ warn "Win32::API::parse_prototype: WARNING unknown output parameter type '$ret'";
+ return ( $proc, \@in_params, \@in_types, type_to_num('I') );
+ }
+
+ } else {
+ warn "Win32::API::parse_prototype: bad prototype '$proto'";
+ return undef;
+ }
+}
+
+1;
+
+__END__
+
+#######################################################################
+# DOCUMENTATION
+#
+
+=head1 NAME
+
+Win32::API - Perl Win32 API Import Facility
+
+=head1 SYNOPSIS
+
+ #### Method 1: with prototype
+
+ use Win32::API;
+ $function = Win32::API->new(
+ 'mydll, 'int sum_integers(int a, int b)',
+ );
+ $return = $function->Call(3, 2);
+
+ #### Method 2: with parameter list
+
+ use Win32::API;
+ $function = Win32::API->new(
+ 'mydll', 'sum_integers', 'II', 'I',
+ );
+ $return = $function->Call(3, 2);
+
+ #### Method 3: with Import
+
+ use Win32::API;
+ Win32::API->Import(
+ 'mydll', 'int sum_integers(int a, int b)',
+ );
+ $return = sum_integers(3, 2);
+
+
+=for LATER-UNIMPLEMENTED
+ #### or
+ use Win32::API mydll => 'int sum_integers(int a, int b)';
+ $return = sum_integers(3, 2);
+
+
+=head1 ABSTRACT
+
+With this module you can import and call arbitrary functions
+from Win32's Dynamic Link Libraries (DLL), without having
+to write an XS extension. Note, however, that this module
+can't do anything (parameters input and output is limited
+to simpler cases), and anyway a regular XS extension is
+always safer and faster.
+
+The current version of Win32::API is available at my website:
+
+ http://dada.perl.it/
+
+It's also available on your nearest CPAN mirror (but allow a few days
+for worldwide spreading of the latest version) reachable at:
+
+ http://www.perl.com/CPAN/authors/Aldo_Calpini/
+
+A short example of how you can use this module (it just gets the PID of
+the current process, eg. same as Perl's internal C<$$>):
+
+ use Win32::API;
+ Win32::API->Import("kernel32", "int GetCurrentProcessId()");
+ $PID = GetCurrentProcessId();
+
+The possibilities are nearly infinite (but not all are good :-).
+Enjoy it.
+
+
+=head1 CREDITS
+
+All the credits go to Andrea Frosini
+for the neat assembler trick that makes this thing work.
+I've also used some work by Dave Roth for the prototyping stuff.
+A big thank you also to Gurusamy Sarathy for his
+unvaluable help in XS development, and to all the Perl community for
+being what it is.
+
+
+=head1 DESCRIPTION
+
+To use this module put the following line at the beginning of your script:
+
+ use Win32::API;
+
+You can now use the C<new()> function of the Win32::API module to create a
+new Win32::API object (see L<IMPORTING A FUNCTION>) and then invoke the
+C<Call()> method on this object to perform a call to the imported API
+(see L<CALLING AN IMPORTED FUNCTION>).
+
+Starting from version 0.40, you can also avoid creating a Win32::API object
+and instead automatically define a Perl sub with the same name of the API
+function you're importing. The details of the API definitions are the same,
+just the call is different:
+
+ my $GetCurrentProcessId = Win32::API->new(
+ "kernel32", "int GetCurrentProcessId()"
+ );
+ my $PID = $GetCurrentProcessId->Call();
+
+ #### vs.
+
+ Win32::API->Import("kernel32", "int GetCurrentProcessId()");
+ $PID = GetCurrentProcessId();
+
+Note that C<Import> returns 1 on success and 0 on failure (in which case you
+can check the content of C<$^E>).
+
+=head2 IMPORTING A FUNCTION
+
+You can import a function from a 32 bit Dynamic Link Library (DLL) file
+with the C<new()> function. This will create a Perl object that contains the
+reference to that function, which you can later C<Call()>.
+
+What you need to know is the prototype of the function you're going to import
+(eg. the definition of the function expressed in C syntax).
+
+Starting from version 0.40, there are 2 different approaches for this step:
+(the preferred) one uses the prototype directly, while the other (now deprecated)
+one uses Win32::API's internal representation for parameters.
+
+=head2 IMPORTING A FUNCTION BY PROTOTYPE
+
+You need to pass 2 parameters:
+
+=over 4
+
+=item 1.
+The name of the library from which you want to import the function.
+
+=item 2.
+The C prototype of the function.
+
+=back
+
+See L<Win32::API::Type> for a list of the known parameter types and
+L<Win32::API::Struct> for information on how to define a structure.
+
+=head2 IMPORTING A FUNCTION WITH A PARAMETER LIST
+
+You need to pass 4 parameters:
+
+=over 4
+
+=item 1.
+The name of the library from which you want to import the function.
+
+=item 2.
+The name of the function (as exported by the library).
+
+=item 3.
+The number and types of the arguments the function expects as input.
+
+=item 4.
+The type of the value returned by the function.
+
+=back
+
+To better explain their meaning, let's suppose that we
+want to import and call the Win32 API C<GetTempPath()>.
+This function is defined in C as:
+
+ DWORD WINAPI GetTempPathA( DWORD nBufferLength, LPSTR lpBuffer );
+
+This is documented in the B<Win32 SDK Reference>; you can look
+for it on the Microsoft's WWW site, or in your C compiler's
+documentation, if you own one.
+
+=over 4
+
+=item B<1.>
+
+The first parameter is the name of the library file that
+exports this function; our function resides in the F<KERNEL32.DLL>
+system file.
+When specifying this name as parameter, the F<.DLL> extension
+is implicit, and if no path is given, the file is searched through
+a couple of directories, including:
+
+=over 4
+
+=item 1. The directory from which the application loaded.
+
+=item 2. The current directory.
+
+=item 3. The Windows system directory (eg. c:\windows\system or system32).
+
+=item 4. The Windows directory (eg. c:\windows).
+
+=item 5. The directories that are listed in the PATH environment variable.
+
+=back
+
+So, you don't have to write F<C:\windows\system\kernel32.dll>;
+only F<kernel32> is enough:
+
+ $GetTempPath = new Win32::API('kernel32', ...
+
+=item B<2.>
+
+Now for the second parameter: the name of the function.
+It must be written exactly as it is exported
+by the library (case is significant here).
+If you are using Windows 95 or NT 4.0, you can use the B<Quick View>
+command on the DLL file to see the function it exports.
+Remember that you can only import functions from 32 bit DLLs:
+in Quick View, the file's characteristics should report
+somewhere "32 bit word machine"; as a rule of thumb,
+when you see that all the exported functions are in upper case,
+the DLL is a 16 bit one and you can't use it.
+If their capitalization looks correct, then it's probably a 32 bit
+DLL.
+
+Also note that many Win32 APIs are exported twice, with the addition of
+a final B<A> or B<W> to their name, for - respectively - the ASCII
+and the Unicode version.
+When a function name is not found, Win32::API will actually append
+an B<A> to the name and try again; if the extension is built on a
+Unicode system, then it will try with the B<W> instead.
+So our function name will be:
+
+ $GetTempPath = new Win32::API('kernel32', 'GetTempPath', ...
+
+In our case C<GetTempPath> is really loaded as C<GetTempPathA>.
+
+=item B<3.>
+
+The third parameter, the input parameter list, specifies how many
+arguments the function wants, and their types. It can be passed as
+a single string, in which each character represents one parameter,
+or as a list reference. The following forms are valid:
+
+ "abcd"
+ [a, b, c, d]
+ \@LIST
+
+But those are not:
+
+ (a, b, c, d)
+ @LIST
+
+The number of characters, or elements in the list, specifies the number
+of parameters, and each character or element specifies the type of an
+argument; allowed types are:
+
+=over 4
+
+=item C<I>:
+value is an integer (int)
+
+=item C<N>:
+value is a number (long)
+
+=item C<F>:
+value is a floating point number (float)
+
+=item C<D>:
+value is a double precision number (double)
+
+=item C<C>:
+value is a char (char)
+
+=item C<P>:
+value is a pointer (to a string, structure, etc...)
+
+=item C<S>:
+value is a Win32::API::Struct object (see below)
+
+=item C<K>:
+value is a Win32::API::Callback object (see L<Win32::API::Callback>)
+
+=back
+
+Our function needs two parameters: a number (C<DWORD>) and a pointer to a
+string (C<LPSTR>):
+
+ $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', ...
+
+=item B<4.>
+
+The fourth and final parameter is the type of the value returned by the
+function. It can be one of the types seen above, plus another type named B<V>
+(for C<void>), used for functions that do not return a value.
+In our example the value returned by GetTempPath() is a C<DWORD>, so
+our return type will be B<N>:
+
+ $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
+
+Now the line is complete, and the GetTempPath() API is ready to be used
+in Perl. Before calling it, you should test that $GetTempPath is
+C<defined>, otherwise either the function or the library could not be
+loaded; in this case, C<$!> will be set to the error message reported
+by Windows.
+Our definition, with error checking added, should then look like this:
+
+ $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
+ if(not defined $GetTempPath) {
+ die "Can't import API GetTempPath: $!\n";
+ }
+
+=back
+
+=head2 CALLING AN IMPORTED FUNCTION
+
+To effectively make a call to an imported function you must use the
+Call() method on the Win32::API object you created.
+Continuing with the example from the previous paragraph,
+the GetTempPath() API can be called using the method:
+
+ $GetTempPath->Call(...
+
+Of course, parameters have to be passed as defined in the import phase.
+In particular, if the number of parameters does not match (in the example,
+if GetTempPath() is called with more or less than two parameters),
+Perl will C<croak> an error message and C<die>.
+
+The two parameters needed here are the length of the buffer
+that will hold the returned temporary path, and a pointer to the
+buffer itself.
+For numerical parameters, you can use either a constant expression
+or a variable, while B<for pointers you must use a variable name> (no
+Perl references, just a plain variable name).
+Also note that B<memory must be allocated before calling the function>,
+just like in C.
+For example, to pass a buffer of 80 characters to GetTempPath(),
+it must be initialized before with:
+
+ $lpBuffer = " " x 80;
+
+This allocates a string of 80 characters. If you don't do so, you'll
+probably get C<Runtime exception> errors, and generally nothing will
+work. The call should therefore include:
+
+ $lpBuffer = " " x 80;
+ $GetTempPath->Call(80, $lpBuffer);
+
+And the result will be stored in the $lpBuffer variable.
+Note that you don't need to pass a reference to the variable
+(eg. you B<don't need> C<\$lpBuffer>), even if its value will be set
+by the function.
+
+A little problem here is that Perl does not trim the variable,
+so $lpBuffer will still contain 80 characters in return; the exceeding
+characters will be spaces, because we said C<" " x 80>.
+
+In this case we're lucky enough, because the value returned by
+the GetTempPath() function is the length of the string, so to get
+the actual temporary path we can write:
+
+ $lpBuffer = " " x 80;
+ $return = $GetTempPath->Call(80, $lpBuffer);
+ $TempPath = substr($lpBuffer, 0, $return);
+
+If you don't know the length of the string, you can usually
+cut it at the C<\0> (ASCII zero) character, which is the string
+delimiter in C:
+
+ $TempPath = ((split(/\0/, $lpBuffer))[0];
+ # or
+ $lpBuffer =~ s/\0.*$//;
+
+=head2 USING STRUCTURES
+
+Starting from version 0.40, Win32::API comes with a support package
+named Win32::API::Struct. The package is loaded automatically with
+Win32::API, so you don't need to use it explicitly.
+
+With this module you can conveniently define structures and use
+them as parameters to Win32::API functions. A short example follows:
+
+
+ # the 'POINT' structure is defined in C as:
+ # typedef struct {
+ # LONG x;
+ # LONG y;
+ # } POINT;
+
+
+ #### define the structure
+ Win32::API::Struct->typedef( POINT => qw{
+ LONG x;
+ LONG y;
+ });
+
+ #### import an API that uses this structure
+ Win32::API->Import('user32', 'BOOL GetCursorPos(LPPOINT lpPoint)');
+
+ #### create a 'POINT' object
+ my $pt = Win32::API::Struct->new('POINT');
+
+ #### call the function passing our structure object
+ GetCursorPos($pt);
+
+ #### and now, access its members
+ print "The cursor is at: $pt->{x}, $pt->{y}\n";
+
+Note that this works only when the function wants a
+B<pointer to a structure>: as you can see, our structure is named
+'POINT', but the API used 'LPPOINT'. 'LP' is automatically added at
+the beginning of the structure name when feeding it to a Win32::API
+call.
+
+For more information, see also L<Win32::API::Struct>.
+
+If you don't want (or can't) use the Win32::API::Struct facility,
+you can still use the low-level approach to use structures:
+
+
+=over 4
+
+=item 1.
+you have to pack() the required elements in a variable:
+
+ $lpPoint = pack('LL', 0, 0); # store two LONGs
+
+=item 2. to access the values stored in a structure, unpack() it as required:
+
+ ($x, $y) = unpack('LL', $lpPoint); # get the actual values
+
+=back
+
+The rest is left as an exercise to the reader...
+
+=head1 AUTHOR
+
+Aldo Calpini ( I<dada@perl.it> ).
+
+=head1 MAINTAINER
+
+Cosimo Streppone ( I<cosimo@cpan.org> )
+
+=cut
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API.pm.orig b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API.pm.orig
new file mode 100644
index 00000000000..9e4accd8bf6
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API.pm.orig
@@ -0,0 +1,741 @@
+package Win32::API;
+
+# See the bottom of this file for the POD documentation. Search for the
+# string '=head'.
+
+#######################################################################
+#
+# Win32::API - Perl Win32 API Import Facility
+#
+# Version: 0.47
+# Date: 12 Nov 2007
+# Author: Aldo Calpini <dada@perl.it>
+# Maintainer: Cosimo Streppone <cosimo@cpan.org>
+#
+# Changes for gcc/cygwin: Daniel Risacher <magnus@alum.mit.edu>
+# ported from 0.41 based on Daniel's patch by Reini Urban <rurban@x-ray.at>
+#
+# $Id: API.pm,v 1.0 2001/10/30 13:57:31 dada Exp $
+#
+#######################################################################
+
+require Exporter; # to export the constants to the main:: space
+require DynaLoader; # to dynuhlode the module.
+@ISA = qw( Exporter DynaLoader );
+
+use vars qw( $DEBUG );
+$DEBUG = 0;
+
+sub DEBUG {
+ if ($Win32::API::DEBUG) {
+ printf @_ if @_ or return 1;
+ } else {
+ return 0;
+ }
+}
+
+use Win32::API::Type;
+use Win32::API::Struct;
+use File::Basename ();
+
+#######################################################################
+# STATIC OBJECT PROPERTIES
+#
+$VERSION = '0.47';
+
+#### some package-global hash to
+#### keep track of the imported
+#### libraries and procedures
+my %Libraries = ();
+my %Procedures = ();
+
+
+#######################################################################
+# dynamically load in the API extension module.
+#
+bootstrap Win32::API;
+
+#######################################################################
+# PUBLIC METHODS
+#
+sub new {
+ my($class, $dll, $proc, $in, $out) = @_;
+ my $hdll;
+ my $self = {};
+
+ if ($^O eq 'cygwin' and $dll ne File::Basename::basename($dll)) {
+ # need to convert $dll to win32 path
+ # isn't there an API for this?
+ my $newdll = `cygpath -w "$dll"`;
+ chomp $newdll;
+ DEBUG "(PM)new: converted '$dll' to\n '$newdll'\n";
+ $dll = $newdll;
+ }
+
+ #### avoid loading a library more than once
+ if(exists($Libraries{$dll})) {
+ DEBUG "Win32::API::new: Library '$dll' already loaded, handle=$Libraries{$dll}\n";
+ $hdll = $Libraries{$dll};
+ } else {
+ DEBUG "Win32::API::new: Loading library '$dll'\n";
+ $hdll = Win32::API::LoadLibrary($dll);
+# $Libraries{$dll} = $hdll;
+ }
+
+ #### if the dll can't be loaded, set $! to Win32's GetLastError()
+ if(!$hdll) {
+ $! = Win32::GetLastError();
+ DEBUG "FAILED Loading library '$dll': $!\n";
+ delete $Libraries{$dll};
+ return undef;
+ }
+
+ #### determine if we have a prototype or not
+ if( (not defined $in) and (not defined $out) ) {
+ ($proc, $self->{in}, $self->{intypes}, $self->{out}) = parse_prototype( $proc );
+ return undef unless $proc;
+ $self->{proto} = 1;
+ } else {
+ $self->{in} = [];
+ if(ref($in) eq 'ARRAY') {
+ foreach (@$in) {
+ push(@{ $self->{in} }, type_to_num($_));
+ }
+ } else {
+ my @in = split '', $in;
+ foreach (@in) {
+ push(@{ $self->{in} }, type_to_num($_));
+ }
+ }
+ $self->{out} = type_to_num($out);
+ }
+
+ #### first try to import the function of given name...
+ my $hproc = Win32::API::GetProcAddress($hdll, $proc);
+
+ #### ...then try appending either A or W (for ASCII or Unicode)
+ if(!$hproc) {
+ my $tproc = $proc;
+ $tproc .= (IsUnicode() ? "W" : "A");
+ # print "Win32::API::new: procedure not found, trying '$tproc'...\n";
+ $hproc = Win32::API::GetProcAddress($hdll, $tproc);
+ }
+
+ #### ...if all that fails, set $! accordingly
+ if(!$hproc) {
+ $! = Win32::GetLastError();
+ DEBUG "FAILED GetProcAddress for Proc '$proc': $!\n";
+ return undef;
+ }
+ DEBUG "GetProcAddress('$proc') = '$hproc'\n";
+
+ #### ok, let's stuff the object
+ $self->{procname} = $proc;
+ $self->{dll} = $hdll;
+ $self->{dllname} = $dll;
+ $self->{proc} = $hproc;
+
+ #### keep track of the imported function
+ $Libraries{$dll} = $hdll;
+ $Procedures{$dll}++;
+
+ DEBUG "Object blessed!\n";
+
+ #### cast the spell
+ bless($self, $class);
+ return $self;
+}
+
+sub Import {
+ my($class, $dll, $proc, $in, $out) = @_;
+ $Imported{"$dll:$proc"} = Win32::API->new($dll, $proc, $in, $out) or return 0;
+ my $P = (caller)[0];
+ eval qq(
+ sub ${P}::$Imported{"$dll:$proc"}->{procname} { \$Win32::API::Imported{"$dll:$proc"}->Call(\@_); }
+ );
+ return $@ ? 0 : 1;
+}
+
+
+#######################################################################
+# PRIVATE METHODS
+#
+sub DESTROY {
+ my($self) = @_;
+
+ #### decrease this library's procedures reference count
+ $Procedures{$self->{dllname}}--;
+
+ #### once it reaches 0, free it
+ if($Procedures{$self->{dllname}} == 0) {
+ DEBUG "Win32::API::DESTROY: Freeing library '$self->{dllname}'\n";
+ Win32::API::FreeLibrary($Libraries{$self->{dllname}});
+ delete($Libraries{$self->{dllname}});
+ }
+}
+
+sub type_to_num {
+ my $type = shift;
+ my $out = shift;
+ my $num;
+
+ if( $type eq 'N'
+ or $type eq 'n'
+ or $type eq 'l'
+ or $type eq 'L'
+ ) {
+ $num = 1;
+ } elsif($type eq 'P'
+ or $type eq 'p'
+ ) {
+ $num = 2;
+ } elsif($type eq 'I'
+ or $type eq 'i'
+ ) {
+ $num = 3;
+ } elsif($type eq 'f'
+ or $type eq 'F'
+ ) {
+ $num = 4;
+ } elsif($type eq 'D'
+ or $type eq 'd'
+ ) {
+ $num = 5;
+ } elsif($type eq 'c'
+ or $type eq 'C'
+ ) {
+ $num = 6;
+ } else {
+ $num = 0;
+ }
+ unless(defined $out) {
+ if( $type eq 's'
+ or $type eq 'S'
+ ) {
+ $num = 51;
+ } elsif($type eq 'b'
+ or $type eq 'B'
+ ) {
+ $num = 22;
+ } elsif($type eq 'k'
+ or $type eq 'K'
+ ) {
+ $num = 101;
+ }
+ }
+ return $num;
+}
+
+sub parse_prototype {
+ my($proto) = @_;
+
+ my @in_params = ();
+ my @in_types = ();
+ if($proto =~ /^\s*(\S+)\s+(\S+)\s*\(([^\)]*)\)/) {
+ my $ret = $1;
+ my $proc = $2;
+ my $params = $3;
+
+ $params =~ s/^\s+//;
+ $params =~ s/\s+$//;
+
+ DEBUG "(PM)parse_prototype: got PROC '%s'\n", $proc;
+ DEBUG "(PM)parse_prototype: got PARAMS '%s'\n", $params;
+
+ foreach my $param (split(/\s*,\s*/, $params)) {
+ my($type, $name);
+ if($param =~ /(\S+)\s+(\S+)/) {
+ ($type, $name) = ($1, $2);
+ }
+
+ if(Win32::API::Type::is_known($type)) {
+ if(Win32::API::Type::is_pointer($type)) {
+ DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
+ $type,
+ Win32::API::Type->packing( $type ),
+ type_to_num('P');
+ push(@in_params, type_to_num('P'));
+ } else {
+ DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
+ $type,
+ Win32::API::Type->packing( $type ),
+ type_to_num( Win32::API::Type->packing( $type ) );
+ push(@in_params, type_to_num( Win32::API::Type->packing( $type ) ));
+ }
+ } elsif( Win32::API::Struct::is_known( $type ) ) {
+ DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
+ $type, 'S', type_to_num('S');
+ push(@in_params, type_to_num('S'));
+ } else {
+ warn "Win32::API::parse_prototype: WARNING unknown parameter type '$type'";
+ push(@in_params, type_to_num('I'));
+ }
+ push(@in_types, $type);
+
+ }
+ DEBUG "parse_prototype: IN=[ @in_params ]\n";
+
+
+
+ if(Win32::API::Type::is_known($ret)) {
+ if(Win32::API::Type::is_pointer($ret)) {
+ DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n",
+ $ret,
+ Win32::API::Type->packing( $ret ),
+ type_to_num('P');
+ return ( $proc, \@in_params, \@in_types, type_to_num('P') );
+ } else {
+ DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n",
+ $ret,
+ Win32::API::Type->packing( $ret ),
+ type_to_num( Win32::API::Type->packing( $ret ) );
+ return ( $proc, \@in_params, \@in_types, type_to_num(Win32::API::Type->packing($ret)) );
+ }
+ } else {
+ warn "Win32::API::parse_prototype: WARNING unknown output parameter type '$ret'";
+ return ( $proc, \@in_params, \@in_types, type_to_num('I') );
+ }
+
+ } else {
+ warn "Win32::API::parse_prototype: bad prototype '$proto'";
+ return undef;
+ }
+}
+
+1;
+
+__END__
+
+#######################################################################
+# DOCUMENTATION
+#
+
+=head1 NAME
+
+Win32::API - Perl Win32 API Import Facility
+
+=head1 SYNOPSIS
+
+ #### Method 1: with prototype
+
+ use Win32::API;
+ $function = Win32::API->new(
+ 'mydll, 'int sum_integers(int a, int b)',
+ );
+ $return = $function->Call(3, 2);
+
+ #### Method 2: with parameter list
+
+ use Win32::API;
+ $function = Win32::API->new(
+ 'mydll', 'sum_integers', 'II', 'I',
+ );
+ $return = $function->Call(3, 2);
+
+ #### Method 3: with Import
+
+ use Win32::API;
+ Win32::API->Import(
+ 'mydll', 'int sum_integers(int a, int b)',
+ );
+ $return = sum_integers(3, 2);
+
+
+=for LATER-UNIMPLEMENTED
+ #### or
+ use Win32::API mydll => 'int sum_integers(int a, int b)';
+ $return = sum_integers(3, 2);
+
+
+=head1 ABSTRACT
+
+With this module you can import and call arbitrary functions
+from Win32's Dynamic Link Libraries (DLL), without having
+to write an XS extension. Note, however, that this module
+can't do anything (parameters input and output is limited
+to simpler cases), and anyway a regular XS extension is
+always safer and faster.
+
+The current version of Win32::API is available at my website:
+
+ http://dada.perl.it/
+
+It's also available on your nearest CPAN mirror (but allow a few days
+for worldwide spreading of the latest version) reachable at:
+
+ http://www.perl.com/CPAN/authors/Aldo_Calpini/
+
+A short example of how you can use this module (it just gets the PID of
+the current process, eg. same as Perl's internal C<$$>):
+
+ use Win32::API;
+ Win32::API->Import("kernel32", "int GetCurrentProcessId()");
+ $PID = GetCurrentProcessId();
+
+The possibilities are nearly infinite (but not all are good :-).
+Enjoy it.
+
+
+=head1 CREDITS
+
+All the credits go to Andrea Frosini
+for the neat assembler trick that makes this thing work.
+I've also used some work by Dave Roth for the prototyping stuff.
+A big thank you also to Gurusamy Sarathy for his
+unvaluable help in XS development, and to all the Perl community for
+being what it is.
+
+
+=head1 DESCRIPTION
+
+To use this module put the following line at the beginning of your script:
+
+ use Win32::API;
+
+You can now use the C<new()> function of the Win32::API module to create a
+new Win32::API object (see L<IMPORTING A FUNCTION>) and then invoke the
+C<Call()> method on this object to perform a call to the imported API
+(see L<CALLING AN IMPORTED FUNCTION>).
+
+Starting from version 0.40, you can also avoid creating a Win32::API object
+and instead automatically define a Perl sub with the same name of the API
+function you're importing. The details of the API definitions are the same,
+just the call is different:
+
+ my $GetCurrentProcessId = Win32::API->new(
+ "kernel32", "int GetCurrentProcessId()"
+ );
+ my $PID = $GetCurrentProcessId->Call();
+
+ #### vs.
+
+ Win32::API->Import("kernel32", "int GetCurrentProcessId()");
+ $PID = GetCurrentProcessId();
+
+Note that C<Import> returns 1 on success and 0 on failure (in which case you
+can check the content of C<$^E>).
+
+=head2 IMPORTING A FUNCTION
+
+You can import a function from a 32 bit Dynamic Link Library (DLL) file
+with the C<new()> function. This will create a Perl object that contains the
+reference to that function, which you can later C<Call()>.
+
+What you need to know is the prototype of the function you're going to import
+(eg. the definition of the function expressed in C syntax).
+
+Starting from version 0.40, there are 2 different approaches for this step:
+(the preferred) one uses the prototype directly, while the other (now deprecated)
+one uses Win32::API's internal representation for parameters.
+
+=head2 IMPORTING A FUNCTION BY PROTOTYPE
+
+You need to pass 2 parameters:
+
+=over 4
+
+=item 1.
+The name of the library from which you want to import the function.
+
+=item 2.
+The C prototype of the function.
+
+=back
+
+See L<Win32::API::Type> for a list of the known parameter types and
+L<Win32::API::Struct> for information on how to define a structure.
+
+=head2 IMPORTING A FUNCTION WITH A PARAMETER LIST
+
+You need to pass 4 parameters:
+
+=over 4
+
+=item 1.
+The name of the library from which you want to import the function.
+
+=item 2.
+The name of the function (as exported by the library).
+
+=item 3.
+The number and types of the arguments the function expects as input.
+
+=item 4.
+The type of the value returned by the function.
+
+=back
+
+To better explain their meaning, let's suppose that we
+want to import and call the Win32 API C<GetTempPath()>.
+This function is defined in C as:
+
+ DWORD WINAPI GetTempPathA( DWORD nBufferLength, LPSTR lpBuffer );
+
+This is documented in the B<Win32 SDK Reference>; you can look
+for it on the Microsoft's WWW site, or in your C compiler's
+documentation, if you own one.
+
+=over 4
+
+=item B<1.>
+
+The first parameter is the name of the library file that
+exports this function; our function resides in the F<KERNEL32.DLL>
+system file.
+When specifying this name as parameter, the F<.DLL> extension
+is implicit, and if no path is given, the file is searched through
+a couple of directories, including:
+
+=over 4
+
+=item 1. The directory from which the application loaded.
+
+=item 2. The current directory.
+
+=item 3. The Windows system directory (eg. c:\windows\system or system32).
+
+=item 4. The Windows directory (eg. c:\windows).
+
+=item 5. The directories that are listed in the PATH environment variable.
+
+=back
+
+So, you don't have to write F<C:\windows\system\kernel32.dll>;
+only F<kernel32> is enough:
+
+ $GetTempPath = new Win32::API('kernel32', ...
+
+=item B<2.>
+
+Now for the second parameter: the name of the function.
+It must be written exactly as it is exported
+by the library (case is significant here).
+If you are using Windows 95 or NT 4.0, you can use the B<Quick View>
+command on the DLL file to see the function it exports.
+Remember that you can only import functions from 32 bit DLLs:
+in Quick View, the file's characteristics should report
+somewhere "32 bit word machine"; as a rule of thumb,
+when you see that all the exported functions are in upper case,
+the DLL is a 16 bit one and you can't use it.
+If their capitalization looks correct, then it's probably a 32 bit
+DLL.
+
+Also note that many Win32 APIs are exported twice, with the addition of
+a final B<A> or B<W> to their name, for - respectively - the ASCII
+and the Unicode version.
+When a function name is not found, Win32::API will actually append
+an B<A> to the name and try again; if the extension is built on a
+Unicode system, then it will try with the B<W> instead.
+So our function name will be:
+
+ $GetTempPath = new Win32::API('kernel32', 'GetTempPath', ...
+
+In our case C<GetTempPath> is really loaded as C<GetTempPathA>.
+
+=item B<3.>
+
+The third parameter, the input parameter list, specifies how many
+arguments the function wants, and their types. It can be passed as
+a single string, in which each character represents one parameter,
+or as a list reference. The following forms are valid:
+
+ "abcd"
+ [a, b, c, d]
+ \@LIST
+
+But those are not:
+
+ (a, b, c, d)
+ @LIST
+
+The number of characters, or elements in the list, specifies the number
+of parameters, and each character or element specifies the type of an
+argument; allowed types are:
+
+=over 4
+
+=item C<I>:
+value is an integer (int)
+
+=item C<N>:
+value is a number (long)
+
+=item C<F>:
+value is a floating point number (float)
+
+=item C<D>:
+value is a double precision number (double)
+
+=item C<C>:
+value is a char (char)
+
+=item C<P>:
+value is a pointer (to a string, structure, etc...)
+
+=item C<S>:
+value is a Win32::API::Struct object (see below)
+
+=item C<K>:
+value is a Win32::API::Callback object (see L<Win32::API::Callback>)
+
+=back
+
+Our function needs two parameters: a number (C<DWORD>) and a pointer to a
+string (C<LPSTR>):
+
+ $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', ...
+
+=item B<4.>
+
+The fourth and final parameter is the type of the value returned by the
+function. It can be one of the types seen above, plus another type named B<V>
+(for C<void>), used for functions that do not return a value.
+In our example the value returned by GetTempPath() is a C<DWORD>, so
+our return type will be B<N>:
+
+ $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
+
+Now the line is complete, and the GetTempPath() API is ready to be used
+in Perl. Before calling it, you should test that $GetTempPath is
+C<defined>, otherwise either the function or the library could not be
+loaded; in this case, C<$!> will be set to the error message reported
+by Windows.
+Our definition, with error checking added, should then look like this:
+
+ $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
+ if(not defined $GetTempPath) {
+ die "Can't import API GetTempPath: $!\n";
+ }
+
+=back
+
+=head2 CALLING AN IMPORTED FUNCTION
+
+To effectively make a call to an imported function you must use the
+Call() method on the Win32::API object you created.
+Continuing with the example from the previous paragraph,
+the GetTempPath() API can be called using the method:
+
+ $GetTempPath->Call(...
+
+Of course, parameters have to be passed as defined in the import phase.
+In particular, if the number of parameters does not match (in the example,
+if GetTempPath() is called with more or less than two parameters),
+Perl will C<croak> an error message and C<die>.
+
+The two parameters needed here are the length of the buffer
+that will hold the returned temporary path, and a pointer to the
+buffer itself.
+For numerical parameters, you can use either a constant expression
+or a variable, while B<for pointers you must use a variable name> (no
+Perl references, just a plain variable name).
+Also note that B<memory must be allocated before calling the function>,
+just like in C.
+For example, to pass a buffer of 80 characters to GetTempPath(),
+it must be initialized before with:
+
+ $lpBuffer = " " x 80;
+
+This allocates a string of 80 characters. If you don't do so, you'll
+probably get C<Runtime exception> errors, and generally nothing will
+work. The call should therefore include:
+
+ $lpBuffer = " " x 80;
+ $GetTempPath->Call(80, $lpBuffer);
+
+And the result will be stored in the $lpBuffer variable.
+Note that you don't need to pass a reference to the variable
+(eg. you B<don't need> C<\$lpBuffer>), even if its value will be set
+by the function.
+
+A little problem here is that Perl does not trim the variable,
+so $lpBuffer will still contain 80 characters in return; the exceeding
+characters will be spaces, because we said C<" " x 80>.
+
+In this case we're lucky enough, because the value returned by
+the GetTempPath() function is the length of the string, so to get
+the actual temporary path we can write:
+
+ $lpBuffer = " " x 80;
+ $return = $GetTempPath->Call(80, $lpBuffer);
+ $TempPath = substr($lpBuffer, 0, $return);
+
+If you don't know the length of the string, you can usually
+cut it at the C<\0> (ASCII zero) character, which is the string
+delimiter in C:
+
+ $TempPath = ((split(/\0/, $lpBuffer))[0];
+ # or
+ $lpBuffer =~ s/\0.*$//;
+
+=head2 USING STRUCTURES
+
+Starting from version 0.40, Win32::API comes with a support package
+named Win32::API::Struct. The package is loaded automatically with
+Win32::API, so you don't need to use it explicitly.
+
+With this module you can conveniently define structures and use
+them as parameters to Win32::API functions. A short example follows:
+
+
+ # the 'POINT' structure is defined in C as:
+ # typedef struct {
+ # LONG x;
+ # LONG y;
+ # } POINT;
+
+
+ #### define the structure
+ Win32::API::Struct->typedef( POINT => qw{
+ LONG x;
+ LONG y;
+ });
+
+ #### import an API that uses this structure
+ Win32::API->Import('user32', 'BOOL GetCursorPos(LPPOINT lpPoint)');
+
+ #### create a 'POINT' object
+ my $pt = Win32::API::Struct->new('POINT');
+
+ #### call the function passing our structure object
+ GetCursorPos($pt);
+
+ #### and now, access its members
+ print "The cursor is at: $pt->{x}, $pt->{y}\n";
+
+Note that this works only when the function wants a
+B<pointer to a structure>: as you can see, our structure is named
+'POINT', but the API used 'LPPOINT'. 'LP' is automatically added at
+the beginning of the structure name when feeding it to a Win32::API
+call.
+
+For more information, see also L<Win32::API::Struct>.
+
+If you don't want (or can't) use the Win32::API::Struct facility,
+you can still use the low-level approach to use structures:
+
+
+=over 4
+
+=item 1.
+you have to pack() the required elements in a variable:
+
+ $lpPoint = pack('LL', 0, 0); # store two LONGs
+
+=item 2. to access the values stored in a structure, unpack() it as required:
+
+ ($x, $y) = unpack('LL', $lpPoint); # get the actual values
+
+=back
+
+The rest is left as an exercise to the reader...
+
+=head1 AUTHOR
+
+Aldo Calpini ( I<dada@perl.it> ).
+
+=head1 MAINTAINER
+
+Cosimo Streppone ( I<cosimo@cpan.org> )
+
+=cut
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Callback.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Callback.pm
new file mode 100644
index 00000000000..22de9d4f46a
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Callback.pm
@@ -0,0 +1,174 @@
+package Win32::API::Callback;
+
+# See the bottom of this file for the POD documentation. Search for the
+# string '=head'.
+
+#######################################################################
+#
+# Win32::API::Callback - Perl Win32 API Import Facility
+#
+# Author: Aldo Calpini <dada@perl.it>
+# Maintainer: Cosimo Streppone <cosimo@cpan.org>
+#
+# $Id: Callback.pm,v 1.0 2001/10/30 13:57:31 dada Exp $
+#
+#######################################################################
+
+$VERSION = '0.47';
+
+require Exporter; # to export the constants to the main:: space
+require DynaLoader; # to dynuhlode the module.
+@ISA = qw( Exporter DynaLoader );
+
+sub DEBUG {
+ if ($WIN32::API::DEBUG) {
+ printf @_ if @_ or return 1;
+ } else {
+ return 0;
+ }
+}
+
+use Win32::API;
+use Win32::API::Type;
+use Win32::API::Struct;
+
+#######################################################################
+# This AUTOLOAD is used to 'autoload' constants from the constant()
+# XS function. If a constant is not found then control is passed
+# to the AUTOLOAD in AutoLoader.
+#
+
+sub AUTOLOAD {
+ my($constname);
+ ($constname = $AUTOLOAD) =~ s/.*:://;
+ #reset $! to zero to reset any current errors.
+ $!=0;
+ my $val = constant($constname, @_ ? $_[0] : 0);
+ if ($! != 0) {
+ if ($! =~ /Invalid/) {
+ $AutoLoader::AUTOLOAD = $AUTOLOAD;
+ goto &AutoLoader::AUTOLOAD;
+ } else {
+ ($pack,$file,$line) = caller;
+ die "Your vendor has not defined Win32::API::Callback macro $constname, used at $file line $line.";
+ }
+ }
+ eval "sub $AUTOLOAD { $val }";
+ goto &$AUTOLOAD;
+}
+
+
+#######################################################################
+# dynamically load in the API extension module.
+#
+bootstrap Win32::API::Callback;
+
+#######################################################################
+# PUBLIC METHODS
+#
+sub new {
+ my($class, $proc, $in, $out) = @_;
+ my %self = ();
+
+ # printf "(PM)Callback::new: got proc='%s', in='%s', out='%s'\n", $proc, $in, $out;
+
+ $self{in} = [];
+ if(ref($in) eq 'ARRAY') {
+ foreach (@$in) {
+ push(@{ $self{in} }, Win32::API::type_to_num($_));
+ }
+ } else {
+ my @in = split '', $in;
+ foreach (@in) {
+ push(@{ $self{in} }, Win32::API::type_to_num($_));
+ }
+ }
+ $self{out} = Win32::API::type_to_num($out);
+ $self{sub} = $proc;
+ my $self = bless \%self, $class;
+
+ DEBUG "(PM)Callback::new: calling CallbackCreate($self)...\n";
+ my $hproc = CallbackCreate($self);
+
+ DEBUG "(PM)Callback::new: hproc=$hproc\n";
+
+ #### ...if that fails, set $! accordingly
+ if(!$hproc) {
+ $! = Win32::GetLastError();
+ return undef;
+ }
+
+ #### ok, let's stuff the object
+ $self->{code} = $hproc;
+ $self->{sub} = $proc;
+
+ #### cast the spell
+ return $self;
+}
+
+sub MakeStruct {
+ my($self, $n, $addr) = @_;
+ DEBUG "(PM)Win32::API::Callback::MakeStruct: got self='$self'\n";
+ my $struct = Win32::API::Struct->new($self->{intypes}->[$n]);
+ $struct->FromMemory($addr);
+ return $struct;
+}
+
+1;
+
+__END__
+
+#######################################################################
+# DOCUMENTATION
+#
+
+=head1 NAME
+
+Win32::API::Callback - Callback support for Win32::API
+
+=head1 SYNOPSIS
+
+ use Win32::API;
+ use Win32::API::Callback;
+
+ my $callback = Win32::API::Callback->new(
+ sub { my($a, $b) = @_; return $a+$b; },
+ "NN", "N",
+ );
+
+ Win32::API->Import(
+ 'mydll', 'two_integers_cb', 'KNN', 'N',
+ );
+
+ $sum = two_integers_cb( $callback, 3, 2 );
+
+
+=head1 FOREWORDS
+
+=over 4
+
+=item *
+Support for this module is B<highly experimental> at this point.
+
+=item *
+I won't be surprised if it doesn't work for you.
+
+=item *
+Feedback is very appreciated.
+
+=item *
+Documentation is in the work. Either see the SYNOPSIS above
+or the samples in the F<samples> directory.
+
+=back
+
+=head1 AUTHOR
+
+Aldo Calpini ( I<dada@perl.it> ).
+
+=head1 MAINTAINER
+
+Cosimo Streppone ( I<cosimo@cpan.org> ).
+
+=cut
+
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Struct.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Struct.pm
new file mode 100644
index 00000000000..05a4c8c60a5
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Struct.pm
@@ -0,0 +1,532 @@
+package Win32::API::Struct;
+
+# See the bottom of this file for the POD documentation. Search for the
+# string '=head'.
+
+#######################################################################
+#
+# Win32::API::Struct - Perl Win32 API struct Facility
+#
+# Author: Aldo Calpini <dada@perl.it>
+# Maintainer: Cosimo Streppone <cosimo@cpan.org>
+#
+# $Id: Struct.pm,v 1.0 2001/10/30 13:57:31 dada Exp $
+#######################################################################
+
+$VERSION = '0.47';
+
+use Win32::API::Type;
+
+use Carp;
+
+require Exporter; # to export the constants to the main:: space
+require DynaLoader; # to dynuhlode the module.
+@ISA = qw( Exporter DynaLoader );
+
+my %Known = ();
+
+sub DEBUG {
+ if ($Win32::API::DEBUG) {
+ printf @_ if @_ or return 1;
+ } else {
+ return 0;
+ }
+}
+
+sub typedef {
+ my $class = shift;
+ my $struct = shift;
+ my($type, $name);
+ my $self = {
+ align => undef,
+ typedef => [],
+ };
+ while(defined($type = shift)) {
+ $name = shift;
+ $name =~ s/;$//;
+ push( @{ $self->{typedef} }, [ recognize($type, $name) ] );
+ }
+
+ $Known{$struct} = $self;
+ return 1;
+}
+
+
+sub recognize {
+ my($type, $name) = @_;
+ my($size, $packing);
+ if(exists $Known{$type}) {
+ $packing = ">";
+ return $name, $packing, $type;
+ } else {
+ $packing = Win32::API::Type::packing($type);
+ return undef unless defined $packing;
+ if($name =~ s/\[(.*)\]$//) {
+ $size = $1;
+ $packing = $packing."*".$size;
+ }
+ DEBUG "(PM)Struct::recognize got '$name', '$type' -> '$packing'\n";
+ return $name, $packing, $type;
+ }
+}
+
+sub new {
+ my $class = shift;
+ my($type, $name);
+ my $self = {
+ typedef => [],
+ };
+ if($#_ == 0) {
+ if(exists $Known{$_[0]}) {
+ DEBUG "(PM)Struct::new: got '$_[0]'\n";
+ $self->{typedef} = $Known{$_[0]}->{typedef};
+ foreach my $member (@{ $self->{typedef} }) {
+ ($name, $packing, $type) = @$member;
+ if($packing eq '>') {
+ $self->{$name} = Win32::API::Struct->new($type);
+ }
+ }
+ $self->{__typedef__} = $_[0];
+ } else {
+ carp "Unknown Win32::API::Struct '$_[0]'";
+ return undef;
+ }
+ } else {
+ while(defined($type = shift)) {
+ $name = shift;
+ # print "new: found member $name ($type)\n";
+ if(not exists $Win32::API::Type::Known{$type}) {
+ warn "Unknown Win32::API::Struct type '$type'";
+ return undef;
+ } else {
+ push( @{ $self->{typedef} }, [ $name, $Win32::API::Type::Known{$type}, $type ] );
+ }
+ }
+ }
+ return bless $self;
+}
+
+sub members {
+ my $self = shift;
+ return map {$_->[0]} @{ $self->{typedef} };
+}
+
+sub sizeof {
+ my $self = shift;
+ my $size = 0;
+ my $align = 0;
+ my $first = undef;
+ foreach my $member (@{ $self->{typedef} }) {
+ my($name, $packing, $type) = @$member;
+
+ if(ref( $self->{$name} ) eq "Win32::API::Struct") {
+ $size += $self->{$name}->sizeof();
+ # $align = $self->{$name}->sizeof() if $self->{$name}->sizeof() > $align;
+ } else {
+ if($packing =~ /\w\*(\d+)/) {
+ $size += Win32::API::Type::sizeof($type) * $1;
+ $first = Win32::API::Type::sizeof($type) * $1 unless defined $first;
+ DEBUG "(PM)Struct::sizeof: sizeof with member($name) now = ". $size. "\n";
+ } else {
+ $size += Win32::API::Type::sizeof($type);
+ $first = Win32::API::Type::sizeof($type) unless defined $first;
+ $align = Win32::API::Type::sizeof($type)
+ if Win32::API::Type::sizeof($type) > $align;
+ DEBUG "(PM)Struct::sizeof: sizeof with member($name) now = ". $size. "\n";
+ }
+ }
+ }
+ DEBUG "(PM)Struct::sizeof first=$first align=$align\n";
+ #DEBUG "(PM)Struct::sizeof returning %d\n", $first + (scalar(@{ $self->{typedef} })-1) * $align;
+ #return $first + (scalar(@{ $self->{typedef} })-1) * $align;
+ DEBUG "(PM)Struct::sizeof returning %d\n", scalar(@{ $self->{typedef} }) * $align;
+ if(defined $align and $align > 0) {
+ return scalar(@{ $self->{typedef} }) * $align;
+ } else {
+ return $size;
+ }
+ return $size;
+}
+
+sub align {
+ my $self = shift;
+ my $align = shift;
+
+ if(not defined $align) {
+ return $self->{align} unless $self->{align} eq 'auto';
+ $align = 0;
+ foreach my $member (@{ $self->{typedef} }) {
+ my($name, $packing, $type) = @$member;
+
+ if(ref( $self->{$name} ) eq "Win32::API::Struct") {
+ #### ????
+ } else {
+ if($packing =~ /\w\*(\d+)/) {
+ #### ????
+ } else {
+ $align = Win32::API::Type::sizeof($type)
+ if Win32::API::Type::sizeof($type) > $align;
+ }
+ }
+ }
+ return $align;
+ } else {
+ $self->{align} = $align;
+
+ }
+}
+
+sub getPack {
+ my $self = shift;
+ my $packing = "";
+ my($type, $name);
+ my @items = ();
+ my @recipients = ();
+
+ my $align = $self->align();
+
+ foreach my $member (@{ $self->{typedef} }) {
+ ($name, $type, $orig) = @$member;
+ if($type eq '>') {
+ my($subpacking, $subitems, $subrecipients) = $self->{$name}->getPack();
+
+ DEBUG "(PM)Struct::getPack($self->{__typedef__}) ++ $subpacking\n";
+
+ $packing .= $subpacking;
+ push(@items, @$subitems);
+ push(@recipients, @$subrecipients);
+ } else {
+ if($type =~ /\w\*(\d+)/) {
+ my $size = $1;
+ $type = "a$size";
+ }
+
+ DEBUG "(PM)Struct::getPack($self->{__typedef__}) ++ $type\n";
+
+ if($type eq 'p') {
+ $type = "L";
+ push(@items, Win32::API::PointerTo($self->{$name}));
+ } else {
+ push(@items, $self->{$name});
+ }
+ $packing .= $type;
+
+ if($Win32::API::Type::PackSize{$type} < $align) {
+ $packing .= ("x" x ($align - $Win32::API::Type::PackSize{$type}));
+ }
+
+ push(@recipients, $self);
+ }
+ }
+ DEBUG "(PM)Struct::getPack: $self->{__typedef__}(buffer) = pack($packing, @items)\n";
+ return($packing, [@items], [@recipients]);
+}
+
+
+sub Pack {
+ my $self = shift;
+ my($packing, $items, $recipients) = $self->getPack();
+ DEBUG "(PM)Struct::Pack: $self->{__typedef__}(buffer) = pack($packing, @$items)\n";
+ $self->{buffer} = pack($packing, @$items);
+ if(DEBUG) {
+ for my $i (0..$self->sizeof-1) {
+ printf " %3d: 0x%02x\n", $i, ord(substr($self->{buffer}, $i, 1));
+ }
+ }
+ $self->{buffer_recipients} = $recipients
+}
+
+sub getUnpack {
+ my $self = shift;
+ my $packing = "";
+ my($type, $name);
+ my @items = ();
+ my $align = $self->align();
+ foreach my $member (@{ $self->{typedef} }) {
+ ($name, $type, $orig) = @$member;
+ if($type eq '>') {
+ my($subpacking, @subitems) = $self->{$name}->getUnpack();
+
+ DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ $subpacking\n";
+ $packing .= $subpacking;
+
+
+ push(@items, @subitems);
+ } else {
+ if($type =~ /\w\*(\d+)/) {
+ my $size = $1;
+ $type = "Z$size";
+ }
+
+ #if($type eq 'p') {
+ # $packing .= 'Z*';
+ # DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ Z*\n";
+ #} else {
+ $packing .= $type;
+ DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ $type\n";
+ #}
+ if($type ne 'p' and $type !~ /^Z(\d+)/ and $Win32::API::Type::PackSize{$type} < $align) {
+ DEBUG "(PM)Struct::getUnpack %s(%d) < %d\n",
+ $type, $Win32::API::Type::PackSize{$type}, $align
+ ;
+ $packing .= ("x" x ($align - $Win32::API::Type::PackSize{$type}));
+ }
+
+ push(@items, $name);
+ }
+ }
+ DEBUG "(PM)Struct::getUnpack($self->{__typedef__}): unpack($packing, @items)\n";
+ return($packing, @items);
+}
+
+sub Unpack {
+ my $self = shift;
+ my($packing, @items) = $self->getUnpack();
+ my @itemvalue = unpack($packing, $self->{buffer});
+ DEBUG "(PM)Struct::Unpack: unpack($packing, buffer) = @itemvalue\n";
+ foreach my $i (0..$#items) {
+ my $recipient = $self->{buffer_recipients}->[$i];
+ DEBUG "(PM)Struct::Unpack: %s(%s) = '%s' (0x%08x)\n",
+ $recipient->{__typedef__},
+ $items[$i],
+ $itemvalue[$i],
+ $itemvalue[$i],
+ ;
+ $recipient->{$items[$i]} = $itemvalue[$i];
+ DEBUG "(PM)Struct::Unpack: self.$items[$i] = $self->{$items[$i]}\n";
+ }
+}
+
+sub FromMemory {
+ my($self, $addr) = @_;
+ DEBUG "(PM)Struct::FromMemory: doing Pack\n";
+ $self->Pack();
+ DEBUG "(PM)Struct::FromMemory: doing GetMemory( 0x%08x, %d )\n", $addr, $self->sizeof;
+ $self->{buffer} = Win32::API::ReadMemory( $addr, $self->sizeof );
+ $self->Unpack();
+ DEBUG "(PM)Struct::FromMemory: doing Unpack\n";
+ DEBUG "(PM)Struct::FromMemory: structure is now:\n";
+ $self->Dump() if DEBUG;
+ DEBUG "\n";
+}
+
+sub Dump {
+ my $self = shift;
+ my $prefix = shift;
+ foreach my $member (@{ $self->{typedef} }) {
+ ($name, $packing, $type) = @$member;
+ if( ref($self->{$name}) ) {
+ $self->{$name}->Dump($name);
+ } else {
+ printf "%-20s %-20s %-20s\n", $prefix, $name, $self->{$name};
+ }
+ }
+}
+
+
+sub is_known {
+ my $name = shift;
+ if(exists $Known{ $name }) {
+ return 1;
+ } else {
+ if($name =~ s/^LP//) {
+ return exists $Known{ $name };
+ }
+ return 0;
+ }
+}
+
+sub TIEHASH {
+ return Win32::API::Struct::new(@_);
+}
+
+sub EXISTS {
+
+}
+
+sub FETCH {
+ my $self = shift;
+ my $key = shift;
+
+ if($key eq 'sizeof') {
+ return $self->sizeof;
+ }
+ my @members = map { $_->[0] } @{ $self->{typedef} };
+ if(grep(/^\Q$key\E$/, @members)) {
+ return $self->{$key};
+ } else {
+ warn "'$key' is not a member of Win32::API::Struct $self->{__typedef__}";
+ }
+}
+
+sub STORE {
+ my $self = shift;
+ my($key, $val) = @_;
+ my @members = map { $_->[0] } @{ $self->{typedef} };
+ if(grep(/^\Q$key\E$/, @members)) {
+ $self->{$key} = $val;
+ } else {
+ warn "'$key' is not a member of Win32::API::Struct $self->{__typedef__}";
+ }
+}
+
+sub FIRSTKEY {
+ my $self = shift;
+ my @members = map { $_->[0] } @{ $self->{typedef} };
+ return $members[0];
+}
+
+sub NEXTKEY {
+ my $self = shift;
+ my $key = shift;
+ my @members = map { $_->[0] } @{ $self->{typedef} };
+ for my $i (0..$#members-1) {
+ return $members[$i+1] if $members[$i] eq $key;
+ }
+ return undef;
+}
+
+1;
+
+#######################################################################
+# DOCUMENTATION
+#
+
+=head1 NAME
+
+Win32::API::Struct - C struct support package for Win32::API
+
+=head1 SYNOPSIS
+
+ use Win32::API;
+
+ Win32::API::Struct->typedef( 'POINT', qw(
+ LONG x;
+ LONG y;
+ ));
+
+ my $Point = Win32::API::Struct->new( 'POINT' );
+ $Point->{x} = 1024;
+ $Point->{y} = 768;
+
+ #### alternatively
+
+ tie %Point, 'Win32::API::Struct', 'POINT';
+ $Point{x} = 1024;
+ $Point{y} = 768;
+
+
+=head1 ABSTRACT
+
+This module enables you to define C structs for use with
+Win32::API.
+
+See L<Win32::API> 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. The main methods are C<typedef> and
+C<new>, which are documented below.
+
+=over 4
+
+=item C<typedef NAME, TYPE, MEMBER, TYPE, MEMBER, ...>
+
+This method defines a structure named C<NAME>. The definition consists
+of types and member names, just like in C. In fact, most of the
+times you can cut the C definition for a structure and paste it
+verbatim to your script, enclosing it in a C<qw()> block. The
+function takes care of removing the semicolon after the member
+name.
+
+The synopsis example could be written like this:
+
+ Win32::API::Struct->typedef('POINT', 'LONG', 'x', 'LONG', 'y');
+
+But it could also be written like this (note the indirect object
+syntax), which is pretty cool:
+
+ typedef Win32::API::Struct POINT => qw{
+ LONG x;
+ LONG y;
+ };
+
+Also note that C<typedef> automatically defines an 'LPNAME' type,
+which holds a pointer to your structure. In the example above,
+'LPPOINT' is also defined and can be used in a call to a
+Win32::API (in fact, this is what you're really going to use when
+doing API calls).
+
+=item C<new NAME>
+
+This creates a structure (a Win32::API::Struct object) of the
+type C<NAME> (it must have been defined with C<typedef>). In Perl,
+when you create a structure, all the members are undefined. But
+when you use that structure in C (eg. a Win32::API call), you
+can safely assume that they will be treated as zero (or NULL).
+
+=item C<sizeof>
+
+This returns the size, in bytes, of the structure. Acts just like
+the C function of the same name. It is particularly useful for
+structures that need a member to be initialized to the structure's
+own size.
+
+=item C<align [SIZE]>
+
+Sets or returns the structure alignment (eg. how the structure is
+stored in memory). This is a very advanced option, and you normally
+don't need to mess with it.
+All structures in the Win32 Platform SDK should work without it.
+But if you define your own structure, you may need to give it an
+explicit alignment. In most cases, passing a C<SIZE> of 'auto'
+should keep the world happy.
+
+=back
+
+=head2 THE C<tie> INTERFACE
+
+Instead of creating an object with the C<new> method, you can
+tie a hash, which will hold the desired structure, using the
+C<tie> builtin function:
+
+ tie %structure, Win32::API::Struct => 'NAME';
+
+The differences between the tied and non-tied approaches are:
+
+=over 4
+
+=item *
+with tied structures, you can access members directly as
+hash lookups, eg.
+
+ # tied # non-tied
+ $Point{x} vs. $Point->{x}
+
+=item *
+with tied structures, when you try to fetch or store a
+member that is not part of the structure, it will result
+in a warning, eg.
+
+ print $Point{z};
+ # this will warn: 'z' is not a member of Win32::API::Struct POINT
+
+=item *
+when you pass a tied structure as a Win32::API parameter,
+remember to backslash it, eg.
+
+ # tied # non-tied
+ GetCursorPos( \%Point ) vs. GetCursorPos( $Point )
+
+=back
+
+=head1 AUTHOR
+
+Aldo Calpini ( I<dada@perl.it> ).
+
+=head1 MAINTAINER
+
+Cosimo Streppone ( I<cosimo@cpan.org> ).
+
+=cut
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Test.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Test.pm
new file mode 100644
index 00000000000..6cbeed6bfac
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Test.pm
@@ -0,0 +1,120 @@
+#
+# Win32::API::Test - Test helper package for Win32::API
+#
+# Version: 0.01
+# Date: 23 Dec 2006
+# Author: Cosimo Streppone <cosimo@cpan.org>
+#
+# $Id: API.pm,v 1.0 2001/10/30 13:57:31 dada Exp $
+#
+package Win32::API::Test;
+
+sub compiler_name () {
+ use Config;
+ my $cc = $Config{ccname};
+ if($cc eq 'cl' || $cc eq 'cl.exe')
+ {
+ $cc = 'cl';
+ }
+ return($cc);
+}
+
+sub compiler_version () {
+ use Config;
+ my $ver = $Config{ccversion} || 0;
+ if( $ver =~ /^(\d+\.\d+)/ )
+ {
+ $ver = 0 + $1;
+ }
+ return($ver);
+}
+
+#
+# Run the compiler and get version from there...
+# User might be running a compiler different from
+# that used to build perl.
+# For example, Cosimo does. For testing, of course.
+#
+# ***
+# *** IT DOES NOT WORK NOW.
+# *** FOR REASONS I DON'T KNOW, CL.EXE OUTPUTS ITS
+# *** VERSION STRING IN THE FIRST TWO LINES THAT
+# *** I'M NOT ABLE TO CATCH...
+# ***
+#
+sub compiler_version_from_shell () {
+ my $cc = compiler_name();
+ my $ver;
+ # MSVC
+ if($cc eq 'cl')
+ {
+ my @ver = `$cc`;
+ my $ver = join('',@ver);
+ print 'VER:'.$ver.':'."\n";
+ if($ver =~ /Version (\d[\d\.]+)/ms )
+ {
+ $ver = $1;
+ }
+ }
+ # GCC
+ elsif($cc eq 'cc' || $cc eq 'gcc' || $cc eq 'winegcc' )
+ {
+ $ver = join('', `$cc --version`);
+ if($ver =~ /gcc.*(\d[\d+]+)/ms )
+ {
+ $ver = $1;
+ }
+ }
+ # Borland C
+ elsif($cc eq 'bcc32' || $cc eq 'bcc')
+ {
+ $ver = join('', `$cc`);
+ if($ver =~ /Borland C\+\+ (\d[\d\.]+)/ms )
+ {
+ $ver = $1;
+ }
+ }
+ return($ver);
+}
+
+sub find_test_dll () {
+ require File::Spec;
+ my $dll_name = $_[0];
+ my @paths = qw(.. ../t ../t/dll . ./dll ./t/dll);
+ while(my $path = shift @paths)
+ {
+ $dll = File::Spec->catfile($path, $dll_name);
+ return $dll if -s $dll;
+ }
+ return(undef);
+}
+
+1;
+
+__END__
+
+
+#######################################################################
+# DOCUMENTATION
+#
+
+=head1 NAME
+
+Win32::API::Test - Test helper package for Win32::API
+
+=head1 SYNOPSIS
+
+ my $test_dll = Win32::API::Test::find_test_dll('API_test.dll');
+
+Check the t/*.t test scripts for more details.
+
+=head1 DESCRIPTION
+
+Simple package to hold Win32::API test suite helper functions.
+No more, no less.
+
+=head1 AUTHOR
+
+Cosimo Streppone ( I<cosimo@cpan.org> )
+
+=cut
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Type.pm b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Type.pm
new file mode 100644
index 00000000000..334b0b731e1
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/Win32/API/Type.pm
@@ -0,0 +1,446 @@
+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 <dada@perl.it>
+# Maintainer: Cosimo Streppone <cosimo@cpan.org>
+#
+# $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 <DATA> approach.
+#
+my $section = 'nothing';
+foreach (<DATA>) {
+ 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<Win32::API> 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<typedef NAME, TYPE>
+
+This method defines a new type named C<NAME>. This actually just
+creates an alias for the already-defined type C<TYPE>, which you
+can use as a parameter in a Win32::API call.
+
+=item C<sizeof TYPE>
+
+This returns the size, in bytes, of C<TYPE>. Acts just like
+the C function of the same name.
+
+=item C<is_known TYPE>
+
+Returns true if C<TYPE> 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<dada@perl.it> ).
+
+=head1 MAINTAINER
+
+Cosimo Streppone ( I<cosimo@cpan.org> ).
+
+=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
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/API.bs b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/API.bs
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/API.bs
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/API.dll b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/API.dll
new file mode 100644
index 00000000000..3a7efc0adca
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/API.dll
Binary files differ
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/Callback/Callback.bs b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/Callback/Callback.bs
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/Callback/Callback.bs
diff --git a/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/Callback/Callback.dll b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/Callback/Callback.dll
new file mode 100644
index 00000000000..147c679d576
--- /dev/null
+++ b/Master/tlpkg/lib/Perl5_lib-TL_inst/auto/Win32/API/Callback/Callback.dll
Binary files differ
diff --git a/Master/wingoo-demo.bat b/Master/wingoo-demo.bat
index 629daae3495..a3589ba8d20 100755
--- a/Master/wingoo-demo.bat
+++ b/Master/wingoo-demo.bat
@@ -9,6 +9,7 @@ set tldrive=%~d0
cd %tlroot%
rem we need wget in the path, so add tlpkg\bin to the path
+set pathsave=%path%
path %path%;%tlroot%tlpkg\bin
rem use provided Perl
@@ -17,11 +18,14 @@ set PERL5SAVE=%PERL5LIB%
set PERL5LIB=%tlroot%tlpkg\lib\Perl5_lib-TL_inst
"%tlroot%tlpkg\bin\perl" "%tlroot%wingoo-demo.pl"
+
pause Done
rem cleanup in case of start from command-line
set PERL5LIB=%PERL5SAVE%
set PERL5SAVE=
+path %pathsave%
+set pathsave=
set tldrive=
set tlroot=
diff --git a/Master/wingoo-demo.pl b/Master/wingoo-demo.pl
index f4697e3c571..fec3ecdf48b 100644
--- a/Master/wingoo-demo.pl
+++ b/Master/wingoo-demo.pl
@@ -20,6 +20,7 @@ BEGIN {
$::installerdir='.';
}
unshift (@INC, "$::installerdir/tlpkg");
+ # unshift (@INC, "$::installerdir/bin/win32") if $^O=~/^MSWin(32|64)$/i;
}
use TeXLive::TLWinGoo; # safe under Unix/Linux!
@@ -44,6 +45,7 @@ sub print_search_paths {
print "User path: ".get_user_path()."\n";
}
+print ((join "\n", @INC)."\n");
# admin
if (admin()) {
@@ -75,7 +77,7 @@ print expand_string("pre\\%systemROOT%\\post")."\n";
# win_which_dir
-print "cmd.exe found in " . win_which_dir("cmd.exe") . "\n";
+print "cmd.exe found in " . TeXLive::TLWinGoo::win_which_dir("cmd.exe") . "\n";
# adding and removing texbindir
@@ -84,27 +86,37 @@ mkdir $wr_dir1 unless -e $wr_dir1;
create_file( $wr_dir1."/tex.exe" );
add_texbindir_to_path($wr_dir1);
print_search_paths();
-print "tex.exe found in " . win_which_dir("tex.exe") . "\n";
+print "tex.exe found in " .
+ TeXLive::TLWinGoo::win_which_dir("tex.exe") . "\n";
my $wr_dir2 = $wr_dir . "/tex2";
mkdir $wr_dir2 unless -e $wr_dir2;
create_file( $wr_dir2."/tex.exe" );
add_texbindir_to_path($wr_dir2);
print_search_paths();
-print "tex.exe found in " . win_which_dir("tex.exe") . "\n";
+print "tex.exe found in " .
+ TeXLive::TLWinGoo::win_which_dir("tex.exe") . "\n";
# the problem case: no admin, but TeX on system path
if (!admin()) {
- my $fn = expand_string("%windir%")."/tex.exe";
+ my $fn = expand_string("%windir%")."/TEX.EXE";
$fn =~ s/\\/\//g;
- create_file($fn);
+ create_file($fn); # a tex.exe on the system path!
add_texbindir_to_path(expand_string($wr_dir2));
+ my @wge = wg_error();
+ if (@wge) {
+ print $wge[1]."\n";
+ }
print_search_paths();
- print "tex.exe found in " . win_which_dir("tex.exe") . "\n";
+ print "tex.exe found in " . TeXLive::TLWinGoo::win_which_dir("tex.exe") . "\n";
unlink $fn;
}
# adding a filetype
register_script_type(".rb","x:/ruby/bin/ruby.exe");
+
+# broadcast environment changes
+
+broadcast_env();