Also updated API stuff in Perl5_lib-TL_ins

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

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
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
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();