Perl library:

- moved around some stuff (lib/lib -> lib)
- updated Win32::API
- removed Env.pm; code incorporated in TLWinGoo
- patched new API.pm for now



git-svn-id: svn://tug.org/texlive/trunk@6347 c570f23f-e606-0410-a88d-b1316a301751

12 files changed, 1132 insertions, 52 deletions

diff --git a/Master/tlpkg/tlperl/lib/lib/Win32/API.pm b/Master/tlpkg/tlperl/lib/Win32/API.pm
index 154de7a80ee..e1bac5cda48 100644
--- a/Master/tlpkg/tlperl/lib/lib/Win32/API.pm
+++ b/Master/tlpkg/tlperl/lib/Win32/API.pm
@@ -7,10 +7,16 @@ package Win32::API;
 #
 # Win32::API - Perl Win32 API Import Facility
 # 
-# Version: 0.41 
-# Date: 10 Mar 2003
+# 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
@@ -30,11 +36,16 @@ sub DEBUG {
 
 use Win32::API::Type;
 use Win32::API::Struct;
+BEGIN {
+  if ($^O eq 'cygwin') {
+    require File::Basename;
+  }
+}
 
 #######################################################################
 # STATIC OBJECT PROPERTIES
 #
-$VERSION = "0.41";
+$VERSION = '0.47';
 
 #### some package-global hash to 
 #### keep track of the imported 
@@ -55,20 +66,31 @@ 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})) {
-        # print "Win32::API::new: Library '$dll' already loaded, handle=$Libraries{$dll}\n";
+        DEBUG "Win32::API::new: Library '$dll' already loaded, handle=$Libraries{$dll}\n";
         $hdll = $Libraries{$dll};
     } else {
-        # print "Win32::API::new: Loading library '$dll'\n";
+        DEBUG "Win32::API::new: Loading library '$dll'\n";
         $hdll = Win32::API::LoadLibrary($dll);
-        $Libraries{$dll} = $hdll;
+#        $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;
     }
 
@@ -106,19 +128,23 @@ sub new {
     #### ...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;
+    $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;
@@ -146,7 +172,7 @@ sub DESTROY {
 
     #### once it reaches 0, free it
     if($Procedures{$self->{dllname}} == 0) {
-        # print "Win32::API::DESTROY: Freeing library '$self->{dllname}'\n";
+        DEBUG "Win32::API::DESTROY: Freeing library '$self->{dllname}'\n";
         Win32::API::FreeLibrary($Libraries{$self->{dllname}});
         delete($Libraries{$self->{dllname}});
     }    
@@ -706,14 +732,14 @@ you have to pack() the required elements in a variable:
 
 =back
 
-
 The rest is left as an exercise to the reader...
 
-
 =head1 AUTHOR
 
 Aldo Calpini ( I<dada@perl.it> ).
 
-=cut
+=head1 MAINTAINER
 
+Cosimo Streppone ( I<cosimo@cpan.org> )
 
+=cut
diff --git a/Master/tlpkg/tlperl/lib/Win32/API.pm.orig b/Master/tlpkg/tlperl/lib/Win32/API.pm.orig
new file mode 100644
index 00000000000..9e4accd8bf6
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/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/tlperl/lib/Win32/API/Callback.pm b/Master/tlpkg/tlperl/lib/Win32/API/Callback.pm
new file mode 100644
index 00000000000..22de9d4f46a
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/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/tlperl/lib/lib/Win32/API/Struct.pm b/Master/tlpkg/tlperl/lib/Win32/API/Struct.pm
index acd160a95a8..05a4c8c60a5 100644
--- a/Master/tlpkg/tlperl/lib/lib/Win32/API/Struct.pm
+++ b/Master/tlpkg/tlperl/lib/Win32/API/Struct.pm
@@ -7,13 +7,13 @@ package Win32::API::Struct;
 #
 # Win32::API::Struct - Perl Win32 API struct Facility
 # 
-# Version: 0.40 
-# Date: 07 Mar 2003
 # 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.40";
+$VERSION = '0.47';
 
 use Win32::API::Type;
 
@@ -525,4 +525,8 @@ remember to backslash it, eg.
 
 Aldo Calpini ( I<dada@perl.it> ).
 
+=head1 MAINTAINER
+
+Cosimo Streppone ( I<cosimo@cpan.org> ).
+
 =cut
diff --git a/Master/tlpkg/tlperl/lib/Win32/API/Test.pm b/Master/tlpkg/tlperl/lib/Win32/API/Test.pm
new file mode 100644
index 00000000000..6cbeed6bfac
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/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/tlperl/lib/lib/Win32/API/Type.pm b/Master/tlpkg/tlperl/lib/Win32/API/Type.pm
index 9ebe9ff57dc..334b0b731e1 100644
--- a/Master/tlpkg/tlperl/lib/lib/Win32/API/Type.pm
+++ b/Master/tlpkg/tlperl/lib/Win32/API/Type.pm
@@ -7,13 +7,13 @@ package Win32::API::Type;
 #
 # Win32::API::Type - Perl Win32 API type definitions
 # 
-# Version: 0.40 
-# Date: 07 Mar 2003
 # 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.40";
+$VERSION = '0.47';
 
 use Carp;
 
@@ -36,39 +36,41 @@ sub DEBUG {
 %Modifier   = ();
 %Pointer    = ();
 
-INIT { 
-    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;
-        }
+# 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;
@@ -270,6 +272,10 @@ for the full list.
 
 Aldo Calpini ( I<dada@perl.it> ).
 
+=head1 MAINTAINER
+
+Cosimo Streppone ( I<cosimo@cpan.org> ).
+
 =cut
 
 
diff --git a/Master/tlpkg/tlperl/lib/auto/Win32/API/.packlist b/Master/tlpkg/tlperl/lib/auto/Win32/API/.packlist
new file mode 100644
index 00000000000..c475031bb6e
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/auto/Win32/API/.packlist
@@ -0,0 +1,9 @@
+X:\perl\site\lib\Win32\API.pm

+X:\perl\site\lib\Win32\API\Callback.pm

+X:\perl\site\lib\Win32\API\Struct.pm

+X:\perl\site\lib\Win32\API\Test.pm

+X:\perl\site\lib\Win32\API\Type.pm

+X:\perl\site\lib\auto\Win32\API\API.bs

+X:\perl\site\lib\auto\Win32\API\API.dll

+X:\perl\site\lib\auto\Win32\API\Callback\Callback.bs

+X:\perl\site\lib\auto\Win32\API\Callback\Callback.dll

diff --git a/Master/tlpkg/tlperl/lib/auto/Win32/API/API.bs b/Master/tlpkg/tlperl/lib/auto/Win32/API/API.bs
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/auto/Win32/API/API.bs
diff --git a/Master/tlpkg/tlperl/lib/auto/Win32/API/API.dll b/Master/tlpkg/tlperl/lib/auto/Win32/API/API.dll
new file mode 100644
index 00000000000..3a7efc0adca
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/auto/Win32/API/API.dll
diff --git a/Master/tlpkg/tlperl/lib/auto/Win32/API/Callback/Callback.bs b/Master/tlpkg/tlperl/lib/auto/Win32/API/Callback/Callback.bs
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/auto/Win32/API/Callback/Callback.bs
diff --git a/Master/tlpkg/tlperl/lib/auto/Win32/API/Callback/Callback.dll b/Master/tlpkg/tlperl/lib/auto/Win32/API/Callback/Callback.dll
new file mode 100644
index 00000000000..147c679d576
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/auto/Win32/API/Callback/Callback.dll
diff --git a/Master/tlpkg/tlperl/lib/lib/auto/Win32/API/API.dll b/Master/tlpkg/tlperl/lib/lib/auto/Win32/API/API.dll
deleted file mode 100755
index 4c478dc3136..00000000000
--- a/Master/tlpkg/tlperl/lib/lib/auto/Win32/API/API.dll
+++ /dev/null