diff options
Diffstat (limited to 'Master/tlpkg/tlperl')
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/OLE.pm | 177 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE.pm | 968 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/Const.pm | 201 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/Enum.pm | 95 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/Lite.pm | 224 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/NEWS.pod | 380 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/NLS.pm | 968 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/TPJ.pod | 798 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/TypeInfo.pm | 389 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/Variant.pm | 577 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/.packlist | 11 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/OLE.dll | bin | 135168 -> 0 bytes |
12 files changed, 0 insertions, 4788 deletions
diff --git a/Master/tlpkg/tlperl/site/lib/OLE.pm b/Master/tlpkg/tlperl/site/lib/OLE.pm deleted file mode 100755 index 234f6986ab3..00000000000 --- a/Master/tlpkg/tlperl/site/lib/OLE.pm +++ /dev/null @@ -1,177 +0,0 @@ -# Compatibility layer for applications using the old toplevel OLE.pm. -# New code should use Win32::OLE - -# This file is based on ../lib/OLE.pm from ActiveState build 315. - -# Compatibility notes: -# - "GetObject" -> "GetActiveObject" -# - "keys %$collection" -> "Win32::OLE::Enum->All($collection)" -# or "in $Collection" -# - "unnamed" default method retries - -######################################################################## -# package Win32; -######################################################################## - -*Win32::OLELastError = sub { return OLE->LastError() }; - - -######################################################################## -package OLE::Variant; -######################################################################## - -use Win32::OLE qw(CP_ACP); -use Win32::OLE::Variant; - -use strict; -use vars qw($AUTOLOAD @ISA $LCID $CP $Warn $LastError $_NewEnum $_Unique); -@ISA = qw(Win32::OLE::Variant); - -$Warn = 0; -$LCID = 2 << 10; # LOCALE_SYSTEM_DEFAULT -$CP = CP_ACP; -$_NewEnum = 0; -$_Unique = 0; - -sub new { - my $self = shift; - my $variant = $self->SUPER::new(@_); - $OLE::LastError = $Win32::OLE->LastError unless defined $variant; - return $variant; -} - - -######################################################################## -package OLE::Tie; -######################################################################## -use strict; -use vars qw(@ISA); -@ISA = qw(Win32::OLE::Tie); - -# !!! It is VERY important that Win32::OLE::Tie::DESTROY gets called. !!! -# If you subclass DESTROY, don't forget to call $self->SUPER::DESTROY. -# Otherwise the OLE interfaces will not be released until process termination! - -# Retry default method if property doesn't exist -sub FETCH { - my ($self,$key) = @_; - return $self->SUPER::Fetch($key, 1); -} - -sub STORE { - my ($self,$key,$value) = @_; - $self->SUPER::Store($key, $value, 1); -} - -# Enumerate collection members, not object properties -*FIRSTKEY = *Win32::OLE::Tie::FIRSTENUM; -*NEXTKEY = *Win32::OLE::Tie::NEXTENUM; - - -######################################################################## -package OLE; -######################################################################## -use Win32::OLE qw(CP_ACP); - -# Use OleInitialize() instead of CoInitializeEx: -Win32::OLE->Initialize(Win32::OLE::COINIT_OLEINITIALIZE); - -use strict; - -# Disable overload; unfortunately "no overload" doesn't do it :-( -# Overloading is no longer enabled by default in Win32::OLE -#use overload '""' => sub {overload::StrVal($_[0])}, -# '0+' => sub {overload::StrVal($_[0])}; - -use vars qw($AUTOLOAD @ISA $LCID $CP $Warn $LastError $Tie); -@ISA = qw(Win32::OLE); - -$Warn = 0; -$LCID = 2 << 10; # LOCALE_SYSTEM_DEFAULT -$CP = CP_ACP; -$Tie = 'OLE::Tie'; - -sub new { - my $class = shift; - $class = shift if $class eq 'OLE'; - return OLE->SUPER::new($class); -} - -sub copy { - my $class = shift; - $class = shift if $class eq 'OLE'; - return OLE->SUPER::GetActiveObject($class); -} - -sub AUTOLOAD { - my $self = shift; - my $retval; - $AUTOLOAD =~ s/.*:://o; - - Carp::croak("Cannot autoload class method \"$AUTOLOAD\"") - unless ref($self) && UNIVERSAL::isa($self,'OLE'); - - local $^H = 0; # !hack alert! - unless (defined $self->Dispatch($AUTOLOAD, $retval, @_)) { - # Retry default method - $self->Dispatch(undef, $retval, $AUTOLOAD, @_); - } - return $retval; -} - -*CreateObject = \&new; -*GetObject = \© - -# Automation data types. - -sub VT_EMPTY {0;} -sub VT_NULL {1;} -sub VT_I2 {2;} -sub VT_I4 {3;} -sub VT_R4 {4;} -sub VT_R8 {5;} -sub VT_CY {6;} -sub VT_DATE {7;} -sub VT_BSTR {8;} -sub VT_DISPATCH {9;} -sub VT_ERROR {10;} -sub VT_BOOL {11;} -sub VT_VARIANT {12;} -sub VT_UNKNOWN {13;} -sub VT_I1 {16;} -sub VT_UI1 {17;} -sub VT_UI2 {18;} -sub VT_UI4 {19;} -sub VT_I8 {20;} -sub VT_UI8 {21;} -sub VT_INT {22;} -sub VT_UINT {23;} -sub VT_VOID {24;} -sub VT_HRESULT {25;} -sub VT_PTR {26;} -sub VT_SAFEARRAY {27;} -sub VT_CARRAY {28;} -sub VT_USERDEFINED {29;} -sub VT_LPSTR {30;} -sub VT_LPWSTR {31;} -sub VT_FILETIME {64;} -sub VT_BLOB {65;} -sub VT_STREAM {66;} -sub VT_STORAGE {67;} -sub VT_STREAMED_OBJECT {68;} -sub VT_STORED_OBJECT {69;} -sub VT_BLOB_OBJECT {70;} -sub VT_CF {71;} -sub VT_CLSID {72;} - -sub TKIND_ENUM {0;} -sub TKIND_RECORD {1;} -sub TKIND_MODULE {2;} -sub TKIND_INTERFACE {3;} -sub TKIND_DISPATCH {4;} -sub TKIND_COCLASS {5;} -sub TKIND_ALIAS {6;} -sub TKIND_UNION {7;} -sub TKIND_MAX {8;} - -1; diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE.pm deleted file mode 100755 index ece534b15fa..00000000000 --- a/Master/tlpkg/tlperl/site/lib/Win32/OLE.pm +++ /dev/null @@ -1,968 +0,0 @@ -# The documentation is at the __END__ - -package Win32::OLE; - -use strict; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL $AUTOLOAD - $CP $LCID $Warn $LastError $_NewEnum $_Unique); - -$VERSION = '0.1712'; - -use Carp; -use Exporter; -use DynaLoader; -@ISA = qw(Exporter DynaLoader); - -@EXPORT = qw(); -@EXPORT_OK = qw(in valof with HRESULT EVENTS OVERLOAD - CP_ACP CP_OEMCP CP_MACCP CP_UTF7 CP_UTF8 - DISPATCH_METHOD DISPATCH_PROPERTYGET - DISPATCH_PROPERTYPUT DISPATCH_PROPERTYPUTREF); -@EXPORT_FAIL = qw(EVENTS OVERLOAD); - -sub export_fail { - shift; - my @unknown; - while (@_) { - my $symbol = shift; - if ($symbol eq 'OVERLOAD') { - eval <<'OVERLOAD'; - use overload '""' => \&valof, - '0+' => \&valof, - fallback => 1; -OVERLOAD - } - elsif ($symbol eq 'EVENTS') { - Win32::OLE->Initialize(Win32::OLE::COINIT_OLEINITIALIZE()); - } - else { - push @unknown, $symbol; - } - } - return @unknown; -} - -unless (defined &Dispatch) { - # Use regular DynaLoader if XS part is not yet initialized - bootstrap Win32::OLE; - require Win32::OLE::Lite; -} - -1; - -######################################################################## - -__END__ - -=head1 NAME - -Win32::OLE - OLE Automation extensions - -=head1 SYNOPSIS - - $ex = Win32::OLE->new('Excel.Application') or die "oops\n"; - $ex->Amethod("arg")->Bmethod->{'Property'} = "foo"; - $ex->Cmethod(undef,undef,$Arg3); - $ex->Dmethod($RequiredArg1, {NamedArg1 => $Value1, NamedArg2 => $Value2}); - - $wd = Win32::OLE->GetObject("D:\\Data\\Message.doc"); - $xl = Win32::OLE->GetActiveObject("Excel.Application"); - -=head1 DESCRIPTION - -This module provides an interface to OLE Automation from Perl. -OLE Automation brings VisualBasic like scripting capabilities and -offers powerful extensibility and the ability to control many Win32 -applications from Perl scripts. - -The Win32::OLE module uses the IDispatch interface exclusively. It is -not possible to access a custom OLE interface. OLE events and OCX's are -currently not supported. - -Actually, that's no longer strictly true. This module now contains -B<ALPHA> level support for OLE events. This is largely untested and the -specific interface might still change in the future. - -=head2 Methods - -=over 8 - -=item Win32::OLE->new(PROGID[, DESTRUCTOR]) - -The new() class method starts a new instance of an OLE Automation object. -It returns a reference to this object or C<undef> if the creation failed. - -The PROGID argument must be either the OLE I<program id> or the I<class id> -of the required application. The optional DESTRUCTOR specifies a DESTROY-like -method. This can be either a CODE reference or a string containing an OLE -method name. It can be used to cleanly terminate OLE applications in case the -Perl program dies. - -To create an object via DCOM on a remote server you can use an array -reference in place of PROGID. The referenced array must contain the -machine name and the I<program id> or I<class id>. For example: - - my $obj = Win32::OLE->new(['my.machine.com', 'Program.Id']); - -If the PROGID is a I<program id> then Win32::OLE will try to resolve the -corresponding I<class id> locally. If the I<program id> is not registered -locally then the remote registry is queried. This will only succeed if -the local process has read access to the remote registry. The safest -(and fastest) method is to specify the C<class id> directly. - -=item Win32::OLE->EnumAllObjects([CALLBACK]) - -This class method returns the number Win32::OLE objects currently in -existence. It will call the optional CALLBACK function for each of -these objects: - - $Count = Win32::OLE->EnumAllObjects(sub { - my $Object = shift; - my $Class = Win32::OLE->QueryObjectType($Object); - printf "# Object=%s Class=%s\n", $Object, $Class; - }); - -The EnumAllObjects() method is primarily a debugging tool. It can be -used e.g. in an END block to check if all external connections have -been properly destroyed. - -=item Win32::OLE->FreeUnusedLibraries() - -The FreeUnusedLibraries() class method unloads all unused OLE -resources. These are the libraries of those classes of which all -existing objects have been destroyed. The unloading of object -libraries is really only important for long running processes that -might instantiate a huge number of B<different> objects over time. - -Be aware that objects implemented in Visual Basic have a buggy -implementation of this functionality: They pretend to be unloadable -while they are actually still running their cleanup code. Unloading -the DLL at that moment typically produces an access violation. The -probability for this problem can be reduced by calling the -SpinMessageLoop() method and sleep()ing for a few seconds. - -=item Win32::OLE->GetActiveObject(CLASS[, DESTRUCTOR]) - -The GetActiveObject() class method returns an OLE reference to a -running instance of the specified OLE automation server. It returns -C<undef> if the server is not currently active. It will croak if -the class is not even registered. The optional DESTRUCTOR method takes -either a method name or a code reference. It is executed when the last -reference to this object goes away. It is generally considered rude -to stop applications that you did not start yourself. - -=item Win32::OLE->GetObject(MONIKER[, DESTRUCTOR]) - -The GetObject() class method returns an OLE reference to the specified -object. The object is specified by a pathname optionally followed by -additional item subcomponent separated by exclamation marks '!'. The -optional DESTRUCTOR argument has the same semantics as the DESTRUCTOR in -new() or GetActiveObject(). - -=item Win32::OLE->Initialize([COINIT]) - -The Initialize() class method can be used to specify an alternative -apartment model for the Perl thread. It must be called B<before> the -first OLE object is created. If the C<Win32::OLE::Const> module is -used then the call to the Initialize() method must be made from a BEGIN -block before the first C<use> statement for the C<Win32::OLE::Const> -module. - -Valid values for COINIT are: - - Win32::OLE::COINIT_APARTMENTTHREADED - single threaded - Win32::OLE::COINIT_MULTITHREADED - the default - Win32::OLE::COINIT_OLEINITIALIZE - single threaded, additional OLE stuff - -COINIT_OLEINITIALIZE is sometimes needed when an OLE object uses -additional OLE compound document technologies not available from the -normal COM subsystem (for example MAPI.Session seems to require it). -Both COINIT_OLEINITIALIZE and COINIT_APARTMENTTHREADED create a hidden -top level window and a message queue for the Perl process. This may -create problems with other application, because Perl normally doesn't -process its message queue. This means programs using synchronous -communication between applications (such as DDE initiation), may hang -until Perl makes another OLE method call/property access or terminates. -This applies to InstallShield setups and many things started to shell -associations. Please try to utilize the C<Win32::OLE-E<gt>SpinMessageLoop> -and C<Win32::OLE-E<gt>Uninitialize> methods if you can not use the default -COINIT_MULTITHREADED model. - -=item OBJECT->Invoke(METHOD[, ARGS]) - -The Invoke() object method is an alternate way to invoke OLE -methods. It is normally equivalent to C<$OBJECT-E<gt>METHOD(@ARGS)>. This -function must be used if the METHOD name contains characters not valid -in a Perl variable name (like foreign language characters). It can -also be used to invoke the default method of an object even if the -default method has not been given a name in the type library. In this -case use <undef> or C<''> as the method name. To invoke an OLE objects -native Invoke() method (if such a thing exists), please use: - - $Object->Invoke('Invoke', @Args); - -=item Win32::OLE->LastError() - -The LastError() class method returns the last recorded OLE -error. This is a dual value like the C<$!> variable: in a numeric -context it returns the error number and in a string context it returns -the error message. The error number is a signed HRESULT value. Please -use the L<HRESULT(ERROR)> function to convert an unsigned hexadecimal -constant to a signed HRESULT. - -The last OLE error is automatically reset by a successful OLE -call. The numeric value can also explicitly be set by a call (which will -discard the string value): - - Win32::OLE->LastError(0); - -=item OBJECT->LetProperty(NAME,ARGS,VALUE) - -In Win32::OLE property assignment using the hash syntax is equivalent -to the Visual Basic C<Set> syntax (I<by reference> assignment): - - $Object->{Property} = $OtherObject; - -corresponds to this Visual Basic statement: - - Set Object.Property = OtherObject - -To get the I<by value> treatment of the Visual Basic C<Let> statement - - Object.Property = OtherObject - -you have to use the LetProperty() object method in Perl: - - $Object->LetProperty($Property, $OtherObject); - -LetProperty() also supports optional arguments for the property assignment. -See L<OBJECT->SetProperty(NAME,ARGS,VALUE)> for details. - -=item Win32::OLE->MessageLoop() - -The MessageLoop() class method will run a standard Windows message -loop, dispatching messages until the QuitMessageLoop() class method is -called. It is used to wait for OLE events. - -=item Win32::OLE->Option(OPTION) - -The Option() class method can be used to inspect and modify -L<Module Options>. The single argument form retrieves the value of -an option: - - my $CP = Win32::OLE->Option('CP'); - -A single call can be used to set multiple options simultaneously: - - Win32::OLE->Option(CP => CP_ACP, Warn => 3); - -=item Win32::OLE->QueryObjectType(OBJECT) - -The QueryObjectType() class method returns a list of the type library -name and the objects class name. In a scalar context it returns the -class name only. It returns C<undef> when the type information is not -available. - -=item Win32::OLE->QuitMessageLoop() - -The QuitMessageLoop() class method posts a (user-level) "Quit" message -to the current threads message loop. QuitMessageLoop() is typically -called from an event handler. The MessageLoop() class method will -return when it receives this "Quit" method. - -=item OBJECT->SetProperty(NAME,ARGS,VALUE) - -The SetProperty() method allows to modify properties with arguments, -which is not supported by the hash syntax. The hash form - - $Object->{Property} = $Value; - -is equivalent to - - $Object->SetProperty('Property', $Value); - -Arguments must be specified between the property name and the new value: - - $Object->SetProperty('Property', @Args, $Value); - -It is not possible to use "named argument" syntax with this function -because the new value must be the last argument to SetProperty(). - -This method hides any native OLE object method called SetProperty(). -The native method will still be available through the Invoke() method: - - $Object->Invoke('SetProperty', @Args); - -=item Win32::OLE->SpinMessageLoop - -This class method retrieves all pending messages from the message queue -and dispatches them to their respective window procedures. Calling this -method is only necessary when not using the COINIT_MULTITHREADED model. -All OLE method calls and property accesses automatically process the -message queue. - -=item Win32::OLE->Uninitialize - -The Uninitialize() class method uninitializes the OLE subsystem. It -also destroys the hidden top level window created by OLE for single -threaded apartments. All OLE objects will become invalid after this call! -It is possible to call the Initialize() class method again with a different -apartment model after shutting down OLE with Uninitialize(). - -=item Win32::OLE->WithEvents(OBJECT[, HANDLER[, INTERFACE]]) - -This class method enables and disables the firing of events by the -specified OBJECT. If no HANDLER is specified, then events are -disconnected. For some objects Win32::OLE is not able to -automatically determine the correct event interface. In this case the -INTERFACE argument must contain either the COCLASS name of the OBJECT -or the name of the event DISPATCH interface. Please read the L<Events> -section below for detailed explanation of the Win32::OLE event -support. - -=back - -Whenever Perl does not find a method name in the Win32::OLE package it -is automatically used as the name of an OLE method and this method call -is dispatched to the OLE server. - -There is one special hack built into the module: If a method or property -name could not be resolved with the OLE object, then the default method -of the object is called with the method name as its first parameter. So - - my $Sheet = $Worksheets->Table1; -or - my $Sheet = $Worksheets->{Table1}; - -is resolved as - - my $Sheet = $Worksheet->Item('Table1'); - -provided that the $Worksheets object does not have a C<Table1> method -or property. This hack has been introduced to call the default method -of collections which did not name the method in their type library. The -recommended way to call the "unnamed" default method is: - - my $Sheet = $Worksheets->Invoke('', 'Table1'); - -This special hack is disabled under C<use strict 'subs';>. - -=head2 Object methods and properties - -The object returned by the new() method can be used to invoke -methods or retrieve properties in the same fashion as described -in the documentation for the particular OLE class (eg. Microsoft -Excel documentation describes the object hierarchy along with the -properties and methods exposed for OLE access). - -Optional parameters on method calls can be omitted by using C<undef> -as a placeholder. A better way is to use named arguments, as the -order of optional parameters may change in later versions of the OLE -server application. Named parameters can be specified in a reference -to a hash as the last parameter to a method call. - -Properties can be retrieved or set using hash syntax, while methods -can be invoked with the usual perl method call syntax. The C<keys> -and C<each> functions can be used to enumerate an object's properties. -Beware that a property is not always writable or even readable (sometimes -raising exceptions when read while being undefined). - -If a method or property returns an embedded OLE object, method -and property access can be chained as shown in the examples below. - -=head2 Functions - -The following functions are not exported by default. - -=over 8 - -=item HRESULT(ERROR) - -The HRESULT() function converts an unsigned number into a signed HRESULT -error value as used by OLE internally. This is necessary because Perl -treats all hexadecimal constants as unsigned. To check if the last OLE -function returned "Member not found" (0x80020003) you can write: - - if (Win32::OLE->LastError == HRESULT(0x80020003)) { - # your error recovery here - } - -=item in(COLLECTION) - -If COLLECTION is an OLE collection object then C<in $COLLECTION> -returns a list of all members of the collection. This is a shortcut -for C<Win32::OLE::Enum-E<gt>All($COLLECTION)>. It is most commonly used in -a C<foreach> loop: - - foreach my $value (in $collection) { - # do something with $value here - } - -=item valof(OBJECT) - -Normal assignment of Perl OLE objects creates just another reference -to the OLE object. The valof() function explictly dereferences the -object (through the default method) and returns the value of the object. - - my $RefOf = $Object; - my $ValOf = valof $Object; - $Object->{Value} = $NewValue; - -Now $ValOf still contains the old value whereas $RefOf would -resolve to the $NewValue because it is still a reference to -$Object. - -The valof() function can also be used to convert Win32::OLE::Variant -objects to Perl values. - -=item with(OBJECT, PROPERTYNAME => VALUE, ...) - -This function provides a concise way to set the values of multiple -properties of an object. It iterates over its arguments doing -C<$OBJECT-E<gt>{PROPERTYNAME} = $VALUE> on each trailing pair. - -=back - -=head2 Overloading - -The Win32::OLE objects can be overloaded to automatically convert to -their values whenever they are used in a bool, numeric or string -context. This is not enabled by default. You have to request it -through the OVERLOAD pseudoexport: - - use Win32::OLE qw(in valof with OVERLOAD); - -You can still get the original string representation of an object -(C<Win32::OLE=0xDEADBEEF>), e.g. for debugging, by using the -C<overload::StrVal()> method: - - print overload::StrVal($object), "\n"; - -Please note that C<OVERLOAD> is a global setting. If any module enables -Win32::OLE overloading then it's active everywhere. - -=head2 Events - -The Win32::OLE module now contains B<ALPHA> level event support. This -support is only available when Perl is running in a single threaded -apartment. This can most easily be assured by using the C<EVENTS> -pseudo-import: - - use Win32::OLE qw(EVENTS); - -which implicitly does something like: - - use Win32::OLE; - Win32::OLE->Initialize(Win32::OLE::COINIT_OLEINITIALIZE); - -The current interface to OLE events should be considered experimental -and is subject to change. It works as expected for normal OLE -applications, but OLE control events often don't seem to work yet. - -Events must be enabled explicitly for an OLE object through the -Win32::OLE->WithEvents() class method. The Win32::OLE module uses the -IProvideClassInfo2 interface to determine the default event source of -the object. If this interface is not supported, then the user must -specify the name of the event source explicitly in the WithEvents() -method call. It is also possible to specify the class name of the -object as the third parameter. In this case Win32::OLE will try to -look up the default source interface for this COCLASS. - -The HANDLER argument to Win32::OLE->WithEvents() can either be a CODE -reference or a package name. In the first case, all events will invoke -this particular function. The first two arguments to this function will -be the OBJECT itself and the name of the event. The remaining arguments -will be event specific. - - sub Event { - my ($Obj,$Event,@Args) = @_; - print "Event triggered: '$Event'\n"; - } - Win32::OLE->WithEvents($Obj, \&Event); - -Alternatively the HANDLER argument can specify a package name. When the -OBJECT fires an event, Win32::OLE will try to find a function of the same -name as the event in this package. This function will be called with the -OBJECT as the first argument followed again by the event specific parameters: - - package MyEvents; - sub EventName1 { - my ($Obj,@Args) = @_; - print "EventName1 event triggered\n"; - } - - package main; - Win32::OLE->WithEvents($Obj, 'MyEvents', 'IEventInterface'); - -If Win32::OLE doesn't find a function with the name of the event then nothing -happens. - -Event parameters passed I<by reference> are handled specially. They are not -converted to the corresponding Perl datatype but passed as Win32::OLE::Variant -objects. You can assign a new value to these objects with the help of the -Put() method. This value will be passed back to the object when the event -function returns: - - package MyEvents; - sub BeforeClose { - my ($self,$Cancel) = @_; - $Cancel->Put(1) unless $MayClose; - } - -Direct assignment to $Cancel would have no effect on the original value and -would therefore not command the object to abort the closing action. - -=head2 Module Options - -The following module options can be accessed and modified with the -C<Win32::OLE-E<gt>Option> class method. In earlier versions of the Win32::OLE -module these options were manipulated directly as class variables. This -practice is now deprecated. - -=over 8 - -=item CP - -This variable is used to determine the codepage used by all -translations between Perl strings and Unicode strings used by the OLE -interface. The default value is CP_ACP, which is the default ANSI -codepage. Other possible values are CP_OEMCP, CP_MACCP, CP_UTF7 and -CP_UTF8. These constants are not exported by default. - -=item LCID - -This variable controls the locale identifier used for all OLE calls. -It is set to LOCALE_NEUTRAL by default. Please check the -L<Win32::OLE::NLS> module for other locale related information. - -=item Variant - -This options controls how method calls and property accessors return -values of type VT_CY and VT_DECIMAL are being returned. By default -VT_CY values are turned into strings and VT_DECIMAL values into -floating point numbers. If the C<Variant> option is enabled, these -values are returned as Win32::OLE::Variant objects, just like VT_DATE -and VT_ERROR values. If the Win32::OLE::Variant module is also -loaded, then all values should still behave as before in string and in -numeric context. - -The only reason that the C<Variant> behavior is not the default is that -this is an incompatible change that might break existing programs. - -=item Warn - -This variable determines the behavior of the Win32::OLE module when -an error happens. Valid values are: - - 0 Ignore error, return undef - 1 Carp::carp if $^W is set (-w option) - 2 always Carp::carp - 3 Carp::croak - -The error number and message (without Carp line/module info) are -available through the C<Win32::OLE-E<gt>LastError> class method. - -Alternatively the Warn option can be set to a CODE reference. E.g. - - Win32::OLE->Option(Warn => 3); - -is equivalent to - - Win32::OLE->Option(Warn => \&Carp::croak); - -This can even be used to emulate the VisualBasic C<On Error Goto -Label> construct: - - Win32::OLE->Option(Warn => sub {goto CheckError}); - # ... your normal OLE code here ... - - CheckError: - # ... your error handling code here ... - -=item _NewEnum - -This option enables additional enumeration support for collection -objects. When the C<_NewEnum> option is set, all collections will -receive one additional property: C<_NewEnum>. The value of this -property will be a reference to an array containing all the elements -of the collection. This option can be useful when used in conjunction -with an automatic tree traversal program, like C<Data::Dumper> or an -object tree browser. The value of this option should be either 1 -(enabled) or 0 (disabled, default). - - Win32::OLE->Option(_NewEnum => 1); - # ... - my @sheets = @{$Excel->Worksheets->{_NewEnum}}; - -In normal application code, this would be better written as: - - use Win32::OLE qw(in); - # ... - my @sheets = in $Excel->Worksheets; - -=item _Unique - -The C<_Unique> options guarantees that Win32::OLE will maintain a -one-to-one mapping between Win32::OLE objects and the native COM/OLE -objects. Without this option, you can query the same property twice -and get two different Win32::OLE objects for the same underlying COM -object. - -Using a unique proxy makes life easier for tree traversal algorithms -to recognize they already visited a particular node. This option -comes at a price: Win32::OLE has to maintain a global hash of all -outstanding objects and their corresponding proxies. Identity checks -on COM objects can also be expensive if the objects reside -out-of-process or even on a different computer. Therefore this option -is off by default unless the program is being run in the debugger. - -Unfortunately, this option doesn't always help. Some programs will -return new COM objects for even the same property when asked for it -multiple times (especially for collections). In this case, there is -nothing Win32::OLE can do to detect that these objects are in fact -identical (because they aren't at the COM level). - -The C<_Unique> option can be set to either 1 (enabled) or 0 (disabled, -default). - -=back - -=head1 EXAMPLES - -Here is a simple Microsoft Excel application. - - use Win32::OLE; - - # use existing instance if Excel is already running - eval {$ex = Win32::OLE->GetActiveObject('Excel.Application')}; - die "Excel not installed" if $@; - unless (defined $ex) { - $ex = Win32::OLE->new('Excel.Application', sub {$_[0]->Quit;}) - or die "Oops, cannot start Excel"; - } - - # get a new workbook - $book = $ex->Workbooks->Add; - - # write to a particular cell - $sheet = $book->Worksheets(1); - $sheet->Cells(1,1)->{Value} = "foo"; - - # write a 2 rows by 3 columns range - $sheet->Range("A8:C9")->{Value} = [[ undef, 'Xyzzy', 'Plugh' ], - [ 42, 'Perl', 3.1415 ]]; - - # print "XyzzyPerl" - $array = $sheet->Range("A8:C9")->{Value}; - for (@$array) { - for (@$_) { - print defined($_) ? "$_|" : "<undef>|"; - } - print "\n"; - } - - # save and exit - $book->SaveAs( 'test.xls' ); - undef $book; - undef $ex; - -Please note the destructor specified on the Win32::OLE->new method. It ensures -that Excel will shutdown properly even if the Perl program dies. Otherwise -there could be a process leak if your application dies after having opened -an OLE instance of Excel. It is the responsibility of the module user to -make sure that all OLE objects are cleaned up properly! - -Here is an example of using Variant data types. - - use Win32::OLE; - use Win32::OLE::Variant; - $ex = Win32::OLE->new('Excel.Application', \&OleQuit) or die "oops\n"; - $ex->{Visible} = 1; - $ex->Workbooks->Add; - # should generate a warning under -w - $ovR8 = Variant(VT_R8, "3 is a good number"); - $ex->Range("A1")->{Value} = $ovR8; - $ex->Range("A2")->{Value} = Variant(VT_DATE, 'Jan 1,1970'); - - sub OleQuit { - my $self = shift; - $self->Quit; - } - -The above will put value "3" in cell A1 rather than the string -"3 is a good number". Cell A2 will contain the date. - -Similarly, to invoke a method with some binary data, you can -do the following: - - $obj->Method( Variant(VT_UI1, "foo\000b\001a\002r") ); - -Here is a wrapper class that basically delegates everything but -new() and DESTROY(). The wrapper class shown here is another way to -properly shut down connections if your application is liable to die -without proper cleanup. Your own wrappers will probably do something -more specific to the particular OLE object you may be dealing with, -like overriding the methods that you may wish to enhance with your -own. - - package Excel; - use Win32::OLE; - - sub new { - my $s = {}; - if ($s->{Ex} = Win32::OLE->new('Excel.Application')) { - return bless $s, shift; - } - return undef; - } - - sub DESTROY { - my $s = shift; - if (exists $s->{Ex}) { - print "# closing connection\n"; - $s->{Ex}->Quit; - return undef; - } - } - - sub AUTOLOAD { - my $s = shift; - $AUTOLOAD =~ s/^.*:://; - $s->{Ex}->$AUTOLOAD(@_); - } - - 1; - -The above module can be used just like Win32::OLE, except that -it takes care of closing connections in case of abnormal exits. -Note that the effect of this specific example can be easier accomplished -using the optional destructor argument of Win32::OLE::new: - - my $Excel = Win32::OLE->new('Excel.Application', sub {$_[0]->Quit;}); - -Note that the delegation shown in the earlier example is not the same as -true subclassing with respect to further inheritance of method calls in your -specialized object. See L<perlobj>, L<perltoot> and L<perlbot> for details. -True subclassing (available by setting C<@ISA>) is also feasible, -as the following example demonstrates: - - # - # Add error reporting to Win32::OLE - # - - package Win32::OLE::Strict; - use Carp; - use Win32::OLE; - - use strict qw(vars); - use vars qw($AUTOLOAD @ISA); - @ISA = qw(Win32::OLE); - - sub AUTOLOAD { - my $obj = shift; - $AUTOLOAD =~ s/^.*:://; - my $meth = $AUTOLOAD; - $AUTOLOAD = "SUPER::" . $AUTOLOAD; - my $retval = $obj->$AUTOLOAD(@_); - unless (defined($retval) || $AUTOLOAD eq 'DESTROY') { - my $err = Win32::OLE::LastError(); - croak(sprintf("$meth returned OLE error 0x%08x",$err)) - if $err; - } - return $retval; - } - - 1; - -This package inherits the constructor new() from the Win32::OLE -package. It is important to note that you cannot later rebless a -Win32::OLE object as some information about the package is cached by -the object. Always invoke the new() constructor through the right -package! - -Here's how the above class will be used: - - use Win32::OLE::Strict; - my $Excel = Win32::OLE::Strict->new('Excel.Application', 'Quit'); - my $Books = $Excel->Workbooks; - $Books->UnknownMethod(42); - -In the sample above the call to UnknownMethod() will be caught with - - UnknownMethod returned OLE error 0x80020009 at test.pl line 5 - -because the Workbooks object inherits the class C<Win32::OLE::Strict> from the -C<$Excel> object. - -=head1 NOTES - -=head2 Hints for Microsoft Office automation - -=over 8 - -=item Documentation - -The object model for the Office applications is defined in the Visual Basic -reference guides for the various applications. These are typically not -installed by default during the standard installation. They can be added -later by rerunning the setup program with the custom install option. - -=item Class, Method and Property names - -The names have been changed between different versions of Office. For -example C<Application> was a method in Office 95 and is a property in -Office97. Therefore it will not show up in the list of property names -C<keys %$object> when querying an Office 95 object. - -The class names are not always identical to the method/property names -producing the object. E.g. the C<Workbook> method returns an object of -type C<Workbook> in Office 95 and C<_Workbook> in Office 97. - -=item Moniker (GetObject support) - -Office applications seem to implement file monikers only. For example -it seems to be impossible to retrieve a specific worksheet object through -C<GetObject("File.XLS!Sheet")>. Furthermore, in Excel 95 the moniker starts -a Worksheet object and in Excel 97 it returns a Workbook object. You can use -either the Win32::OLE::QueryObjectType class method or the $object->{Version} -property to write portable code. - -=item Enumeration of collection objects - -Enumerations seem to be incompletely implemented. Office 95 application don't -seem to support neither the Reset() nor the Clone() methods. The Clone() -method is still unimplemented in Office 97. A single walk through the -collection similar to Visual Basics C<for each> construct does work however. - -=item Localization - -Starting with Office 97 Microsoft has changed the localized class, method and -property names back into English. Note that string, date and currency -arguments are still subject to locale specific interpretation. Perl uses the -system default locale for all OLE transaction whereas Visual Basic uses a -type library specific locale. A Visual Basic script would use "R1C1" in string -arguments to specify relative references. A Perl script running on a German -language Windows would have to use "Z1S1". Set the LCID module option -to an English locale to write portable scripts. This variable should -not be changed after creating the OLE objects; some methods seem to randomly -fail if the locale is changed on the fly. - -=item SaveAs method in Word 97 doesn't work - -This is an known bug in Word 97. Search the MS knowledge base for Word / -Foxpro incompatibility. That problem applies to the Perl OLE interface as -well. A workaround is to use the WordBasic compatibility object. It doesn't -support all the options of the native method though. - - $Word->WordBasic->FileSaveAs($file); - -The problem seems to be fixed by applying the Office 97 Service Release 1. - -=item Randomly failing method calls - -It seems like modifying objects that are not selected/activated is sometimes -fragile. Most of these problems go away if the chart/sheet/document is -selected or activated before being manipulated (just like an interactive -user would automatically do it). - -=back - -=head2 Incompatibilities - -There are some incompatibilities with the version distributed by Activeware -(as of build 306). - -=over 8 - -=item 1 - -The package name has changed from "OLE" to "Win32::OLE". - -=item 2 - -All functions of the form "Win32::OLEFoo" are now "Win32::OLE::Foo", -though the old names are temporarily accommodated. Win32::OLECreateObject() -was changed to Win32::OLE::CreateObject(), and is now called -Win32::OLE::new() bowing to established convention for naming constructors. -The old names should be considered deprecated, and will be removed in the -next version. - -=item 3 - -Package "OLE::Variant" is now "Win32::OLE::Variant". - -=item 4 - -The Variant function is new, and is exported by default. So are -all the VT_XXX type constants. - -=item 5 - -The support for collection objects has been moved into the package -Win32::OLE::Enum. The C<keys %$object> method is now used to enumerate -the properties of the object. - -=back - -=head2 Bugs and Limitations - -=over 8 - -=item * - -To invoke a native OLE method with the same name as one of the -Win32::OLE methods (C<Dispatch>, C<Invoke>, C<SetProperty>, C<DESTROY>, -etc.), you have to use the C<Invoke> method: - - $Object->Invoke('Dispatch', @AdditionalArgs); - -The same is true for names exported by the Exporter or the Dynaloader -modules, e.g.: C<export>, C<export_to_level>, C<import>, -C<_push_tags>, C<export_tags>, C<export_ok_tags>, C<export_fail>, -C<require_version>, C<dl_load_flags>, -C<croak>, C<bootstrap>, C<dl_findfile>, C<dl_expandspec>, -C<dl_find_symbol_anywhere>, C<dl_load_file>, C<dl_find_symbol>, -C<dl_undef_symbols>, C<dl_install_xsub> and C<dl_error>. - -=back - -=head1 SEE ALSO - -The documentation for L<Win32::OLE::Const>, L<Win32::OLE::Enum>, -L<Win32::OLE::NLS> and L<Win32::OLE::Variant> contains additional -information about OLE support for Perl on Win32. - -=head1 AUTHORS - -Originally put together by the kind people at Hip and Activeware. - -Gurusamy Sarathy <gsar@cpan.org> subsequently fixed several -major bugs, memory leaks, and reliability problems, along with some -redesign of the code. - -Jan Dubois <jand@activestate.com> pitched in with yet more massive redesign, -added support for named parameters, and other significant enhancements. -He's been hacking on it ever since. - -Please send questions about problems with this module to the -Perl-Win32-Users mailinglist at ActiveState.com. The mailinglist charter -requests that you put an [OLE] tag somewhere on the subject line (for OLE -related questions only, of course). - -=head1 COPYRIGHT - - (c) 1995 Microsoft Corporation. All rights reserved. - Developed by ActiveWare Internet Corp., now known as - ActiveState Tool Corp., http://www.ActiveState.com - - Other modifications Copyright (c) 1997-2006 by Gurusamy Sarathy - <gsar@cpan.org> and Jan Dubois <jand@activestate.com> - - You may distribute under the terms of either the GNU General Public - License or the Artistic License, as specified in the README file. - -=head1 VERSION - -Version 0.1712 14 May 2014 - -=cut diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/Const.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE/Const.pm deleted file mode 100755 index d0fe00b9ea7..00000000000 --- a/Master/tlpkg/tlperl/site/lib/Win32/OLE/Const.pm +++ /dev/null @@ -1,201 +0,0 @@ -# The documentation is at the __END__ - -package Win32::OLE::Const; - -use strict; -use Carp; -use Win32::OLE; - -my $Typelibs; -sub _Typelib { - my ($clsid,$title,$version,$langid,$filename) = @_; - # Filenames might have a resource index appended to it. - $filename = $1 if $filename =~ /^(.*\.(?:dll|exe))(\\\d+)$/i; - # Ignore if it looks like a file but doesn't exist. - # We don't verify existence of monikers or filenames - # without a full pathname. - return if $filename =~ /^\w:\\.*\.(exe|dll)$/ && !-f $filename; - push @$Typelibs, \@_; -} -unless (__PACKAGE__->_Typelibs("TypeLib")) { - warn("Cannot access HKEY_CLASSES_ROOT\\Typelib"); -} -# Enumerate 32bit type libraries on Win64 -__PACKAGE__->_Typelibs("Wow6432Node\\TypeLib"); - -sub import { - my ($self,$name,$major,$minor,$language,$codepage) = @_; - return unless defined($name) && $name !~ /^\s*$/; - $self->Load($name,$major,$minor,$language,$codepage,scalar caller); -} - -sub EnumTypeLibs { - my ($self,$callback) = @_; - foreach (@$Typelibs) { &$callback(@$_) } - return; -} - -sub Load { - my ($self,$name,$major,$minor,$language,$codepage,$caller) = @_; - - if (UNIVERSAL::isa($name,'Win32::OLE')) { - my $typelib = $name->GetTypeInfo->GetContainingTypeLib; - return _Constants($typelib, undef); - } - - undef $minor unless defined $major; - my $typelib = $self->LoadRegTypeLib($name,$major,$minor, - $language,$codepage); - return _Constants($typelib, $caller); -} - -sub LoadRegTypeLib { - my ($self,$name,$major,$minor,$language,$codepage) = @_; - undef $minor unless defined $major; - - unless (defined($name) && $name !~ /^\s*$/) { - carp "Win32::OLE::Const->Load: No or invalid type library name"; - return; - } - - my @found; - foreach my $Typelib (@$Typelibs) { - my ($clsid,$title,$version,$langid,$filename) = @$Typelib; - next unless $title =~ /^$name/; - next unless $version =~ /^([0-9a-fA-F]+)\.([0-9a-fA-F]+)$/; - my ($maj,$min) = (hex($1), hex($2)); - next if defined($major) && $maj != $major; - next if defined($minor) && $min < $minor; - next if defined($language) && $language != $langid; - push @found, [$clsid,$maj,$min,$langid,$filename]; - } - - unless (@found) { - carp "No type library matching \"$name\" found"; - return; - } - - @found = sort { - # Prefer greater version number - my $res = $b->[1] <=> $a->[1]; - $res = $b->[2] <=> $a->[2] if $res == 0; - # Prefer default language for equal version numbers - $res = -1 if $res == 0 && $a->[3] == 0; - $res = 1 if $res == 0 && $b->[3] == 0; - $res; - } @found; - - #printf "Loading %s\n", join(' ', @{$found[0]}); - return _LoadRegTypeLib(@{$found[0]},$codepage); -} - -1; - -__END__ - -=head1 NAME - -Win32::OLE::Const - Extract constant definitions from TypeLib - -=head1 SYNOPSIS - - use Win32::OLE::Const 'Microsoft Excel'; - printf "xlMarkerStyleDot = %d\n", xlMarkerStyleDot; - - my $wd = Win32::OLE::Const->Load("Microsoft Word 8\\.0 Object Library"); - foreach my $key (keys %$wd) { - printf "$key = %s\n", $wd->{$key}; - } - -=head1 DESCRIPTION - -This modules makes all constants from a registered OLE type library -available to the Perl program. The constant definitions can be -imported as functions, providing compile time name checking. -Alternatively the constants can be returned in a hash reference -which avoids defining lots of functions of unknown names. - -=head2 Functions/Methods - -=over 4 - -=item use Win32::OLE::Const - -The C<use> statement can be used to directly import the constant names -and values into the users namespace. - - use Win32::OLE::Const (TYPELIB,MAJOR,MINOR,LANGUAGE); - -The TYPELIB argument specifies a regular expression for searching -through the registry for the type library. Note that this argument is -implicitly prefixed with C<^> to speed up matches in the most common -cases. Use a typelib name like ".*Excel" to match anywhere within the -description. TYPELIB is the only required argument. - -The MAJOR and MINOR arguments specify the requested version of -the type specification. If the MAJOR argument is used then only -typelibs with exactly this major version number will be matched. The -MINOR argument however specifies the minimum acceptable minor version. -MINOR is ignored if MAJOR is undefined. - -If the LANGUAGE argument is used then only typelibs with exactly this -language id will be matched. - -The module will select the typelib with the highest version number -satisfying the request. If no language id is specified then a the default -language (0) will be preferred over the others. - -Note that only constants with valid Perl variable names will be exported, -i.e. names matching this regexp: C</^[a-zA-Z_][a-zA-Z0-9_]*$/>. - -=item Win32::OLE::Const->Load - -The Win32::OLE::Const->Load method returns a reference to a hash of -constant definitions. - - my $const = Win32::OLE::Const->Load(TYPELIB,MAJOR,MINOR,LANGUAGE); - -The parameters are the same as for the C<use> case. - -This method is generally preferable when the typelib uses a non-english -language and the constant names contain locale specific characters not -allowed in Perl variable names. - -Another advantage is that all available constants can now be enumerated. - -The load method also accepts an OLE object as a parameter. In this case -the OLE object is queried about its containing type library and no registry -search is done at all. Interestingly this seems to be slower. - -=back - -=head1 EXAMPLES - -The first example imports all Excel constants names into the main namespace -and prints the value of xlMarkerStyleDot (-4118). - - use Win32::OLE::Const ('Microsoft Excel 8.0 Object Library'); - print "xlMarkerStyleDot = %d\n", xlMarkerStyleDot; - -The second example returns all Word constants in a hash ref. - - use Win32::OLE::Const; - my $wd = Win32::OLE::Const->Load("Microsoft Word 8.0 Object Library"); - foreach my $key (keys %$wd) { - printf "$key = %s\n", $wd->{$key}; - } - printf "wdGreen = %s\n", $wd->{wdGreen}; - -The last example uses an OLE object to specify the type library: - - use Win32::OLE; - use Win32::OLE::Const; - my $Excel = Win32::OLE->new('Excel.Application', 'Quit'); - my $xl = Win32::OLE::Const->Load($Excel); - - -=head1 AUTHORS/COPYRIGHT - -This module is part of the Win32::OLE distribution. - -=cut diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/Enum.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE/Enum.pm deleted file mode 100755 index 6047d2c8274..00000000000 --- a/Master/tlpkg/tlperl/site/lib/Win32/OLE/Enum.pm +++ /dev/null @@ -1,95 +0,0 @@ -# The documentation is at the __END__ - -package Win32::OLE::Enum; -1; - -# everything is pure XS in Win32::OLE::Enum -# - new -# - DESTROY -# -# - All -# - Clone -# - Next -# - Reset -# - Skip - -__END__ - -=head1 NAME - -Win32::OLE::Enum - OLE Automation Collection Objects - -=head1 SYNOPSIS - - my $Sheets = $Excel->Workbooks(1)->Worksheets; - my $Enum = Win32::OLE::Enum->new($Sheets); - my @Sheets = $Enum->All; - - while (defined(my $Sheet = $Enum->Next)) { ... } - -=head1 DESCRIPTION - -This module provides an interface to OLE collection objects from -Perl. It defines an enumerator object closely mirroring the -functionality of the IEnumVARIANT interface. - -Please note that the Reset() method is not available in all implementations -of OLE collections (like Excel 7). In that case the Enum object is good -only for a single walk through of the collection. - -=head2 Functions/Methods - -=over 8 - -=item Win32::OLE::Enum->new($object) - -Creates an enumerator for $object, which must be a valid OLE collection -object. Note that correctly implemented collection objects must support -the C<Count> and C<Item> methods, so creating an enumerator is not always -necessary. - -=item $Enum->All() - -Returns a list of all objects in the collection. You have to call -$Enum->Reset() before the enumerator can be used again. The previous -position in the collection is lost. - -This method can also be called as a class method: - - my @list = Win32::OLE::Enum->All($Collection); - -=item $Enum->Clone() - -Returns a clone of the enumerator maintaining the current position within -the collection (if possible). Note that the C<Clone> method is often not -implemented. Use $Enum->Clone() in an eval block to avoid dying if you -are not sure that Clone is supported. - -=item $Enum->Next( [$count] ) - -Returns the next element of the collection. In a list context the optional -$count argument specifies the number of objects to be returned. In a scalar -context only the last of at most $count retrieved objects is returned. The -default for $count is 1. - -=item $Enum->Reset() - -Resets the enumeration sequence to the beginning. There is no guarantee that -the exact same set of objects will be enumerated again (e.g. when enumerating -files in a directory). The methods return value indicates the success of the -operation. (Note that the Reset() method seems to be unimplemented in some -applications like Excel 7. Use it in an eval block to avoid dying.) - -=item $Enum->Skip( [$count] ) - -Skip the next $count elements of the enumeration. The default for $count is 1. -The functions returns TRUE if at least $count elements could be skipped. It -returns FALSE if not enough elements were left. - -=back - -=head1 AUTHORS/COPYRIGHT - -This module is part of the Win32::OLE distribution. - -=cut diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/Lite.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE/Lite.pm deleted file mode 100755 index 66b5e50ac0e..00000000000 --- a/Master/tlpkg/tlperl/site/lib/Win32/OLE/Lite.pm +++ /dev/null @@ -1,224 +0,0 @@ -package Win32::OLE; - -sub _croak { require Carp; Carp::croak(@_) } - -unless (defined &Dispatch) { - DynaLoader::boot_DynaLoader('DynaLoader') - unless defined(&DynaLoader::dl_load_file); - my $file; - foreach my $dir (@INC) { - my $try = "$dir/auto/Win32/OLE/OLE.dll"; - last if $file = (-f $try && $try); - } - _croak("Can't locate loadable object for module Win32::OLE". - " in \@INC (\@INC contains: @INC)") - unless $file; # wording similar to error from 'require' - - my $libref = DynaLoader::dl_load_file($file, 0) or - _croak("Can't load '$file' for module Win32::OLE: ". - DynaLoader::dl_error()."\n"); - - my $boot_symbol_ref = DynaLoader::dl_find_symbol($libref, "boot_Win32__OLE") - or _croak("Can't find 'boot_Win32__OLE' symbol in $file\n"); - - my $xs = DynaLoader::dl_install_xsub("Win32::OLE::bootstrap", - $boot_symbol_ref, $file); - &$xs('Win32::OLE'); -} - -if (defined &DB::sub && !defined $_Unique) { - warn "Win32::OLE operating in debugging mode: _Unique => 1\n"; - $_Unique = 1; -} - -$Warn = 1; - -sub CP_ACP {0;} # ANSI codepage -sub CP_OEMCP {1;} # OEM codepage -sub CP_MACCP {2;} -sub CP_UTF7 {65000;} -sub CP_UTF8 {65001;} - -sub DISPATCH_METHOD {1;} -sub DISPATCH_PROPERTYGET {2;} -sub DISPATCH_PROPERTYPUT {4;} -sub DISPATCH_PROPERTYPUTREF {8;} - -sub COINIT_MULTITHREADED {0;} # Default -sub COINIT_APARTMENTTHREADED {2;} # Use single threaded apartment model - -# Bogus COINIT_* values to indicate special cases: -sub COINIT_OLEINITIALIZE {-1;} # Use OleInitialize instead of CoInitializeEx -sub COINIT_NO_INITIALIZE {-2;} # We are already initialized, just believe me - -sub HRESULT { - my $hr = shift; - $hr -= 2**32 if $hr & 0x80000000; - return $hr; -} - -# CreateObject is defined here only because it is documented in the -# "Learning Perl on Win32 Systems" Gecko book. Please use Win32::OLE->new(). -sub CreateObject { - if (ref($_[0]) && UNIVERSAL::isa($_[0],'Win32::OLE')) { - $AUTOLOAD = ref($_[0]) . '::CreateObject'; - goto &AUTOLOAD; - } - - # Hack to allow C<$obj = CreateObject Win32::OLE 'My.App';>. Although this - # is contrary to the Gecko, we just make it work since it doesn't hurt. - return Win32::OLE->new($_[1]) if $_[0] eq 'Win32::OLE'; - - # Gecko form: C<$success = Win32::OLE::CreateObject('My.App',$obj);> - $_[1] = Win32::OLE->new($_[0]); - return defined $_[1]; -} - -sub LastError { - unless (defined $_[0]) { - # Win32::OLE::LastError() will always return $Win32::OLE::LastError - return $LastError; - } - - if (ref($_[0]) && UNIVERSAL::isa($_[0],'Win32::OLE')) { - $AUTOLOAD = ref($_[0]) . '::LastError'; - goto &AUTOLOAD; - } - - #no strict 'refs'; - my $LastError = "$_[0]::LastError"; - $$LastError = $_[1] if defined $_[1]; - return $$LastError; -} - -my $Options = "^(?:CP|LCID|Warn|Variant|_NewEnum|_Unique)\$"; - -sub Option { - if (ref($_[0]) && UNIVERSAL::isa($_[0],'Win32::OLE')) { - $AUTOLOAD = ref($_[0]) . '::Option'; - goto &AUTOLOAD; - } - - my $class = shift; - - if (@_ == 1) { - my $option = shift; - return ${"${class}::$option"} if $option =~ /$Options/o; - _croak("Invalid $class option: $option"); - } - - while (@_) { - my ($option,$value) = splice @_, 0, 2; - _croak("Invalid $class option: $option") if $option !~ /$Options/o; - ${"${class}::$option"} = $value; - $class->_Unique() if $option eq "_Unique"; - } -} - -sub Invoke { - my ($self,$method,@args) = @_; - $self->Dispatch($method, my $retval, @args); - return $retval; -} - -sub LetProperty { - my ($self,$method,@args) = @_; - $self->Dispatch([DISPATCH_PROPERTYPUT, $method], my $retval, @args); - return $retval; -} - -sub SetProperty { - my ($self,$method,@args) = @_; - my $wFlags = DISPATCH_PROPERTYPUT; - if (@args) { - # If the value is an object then it will be set by reference! - my $value = $args[-1]; - if (UNIVERSAL::isa($value, 'Win32::OLE')) { - $wFlags = DISPATCH_PROPERTYPUTREF; - } - elsif (UNIVERSAL::isa($value,'Win32::OLE::Variant')) { - my $type = $value->Type & ~0xfff; # VT_TYPEMASK - # VT_DISPATCH and VT_UNKNOWN represent COM objects - $wFlags = DISPATCH_PROPERTYPUTREF if $type == 9 || $type == 13; - } - } - $self->Dispatch([$wFlags, $method], my $retval, @args); - return $retval; -} - -sub AUTOLOAD { - my $self = shift; - my $autoload = substr $AUTOLOAD, rindex($AUTOLOAD, ':')+1; - _croak("Cannot autoload class method \"$autoload\"") - unless ref($self) && UNIVERSAL::isa($self, 'Win32::OLE'); - my $success = $self->Dispatch($autoload, my $retval, @_); - unless (defined $success || ($^H & 0x200) != 0) { - # Retry default method if C<no strict 'subs';> - $self->Dispatch(undef, $retval, $autoload, @_); - } - return $retval; -} - -sub in { - my @res; - while (@_) { - my $this = shift; - if (UNIVERSAL::isa($this, 'Win32::OLE')) { - push @res, Win32::OLE::Enum->All($this); - } - elsif (ref($this) eq 'ARRAY') { - push @res, @$this; - } - else { - push @res, $this; - } - } - return @res; -} - -sub valof { - my $arg = shift; - if (UNIVERSAL::isa($arg, 'Win32::OLE')) { - require Win32::OLE::Variant; - my ($class) = overload::StrVal($arg) =~ /^([^=]+)=/; - #no strict 'refs'; - local $Win32::OLE::CP = ${"${class}::CP"}; - local $Win32::OLE::LCID = ${"${class}::LCID"}; - #use strict 'refs'; - # VT_EMPTY variant for return code - my $variant = Win32::OLE::Variant->new; - $arg->Dispatch(undef, $variant); - return $variant->Value; - } - $arg = $arg->Value if UNIVERSAL::can($arg, 'Value'); - return $arg; -} - -sub with { - my $object = shift; - while (@_) { - my $property = shift; - $object->{$property} = shift; - } -} - -######################################################################## - -package Win32::OLE::Tie; - -# Only retry default method under C<no strict 'subs';> -sub FETCH { - my ($self,$key) = @_; - if ($key eq "_NewEnum") { - (my $class = ref $self) =~ s/::Tie$//; - return [Win32::OLE::Enum->All($self)] if ${"${class}::_NewEnum"}; - } - $self->Fetch($key, !$Win32::OLE::Strict); -} - -sub STORE { - my ($self,$key,$value) = @_; - $self->Store($key, $value, !$Win32::OLE::Strict); -} - -1; diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/NEWS.pod b/Master/tlpkg/tlperl/site/lib/Win32/OLE/NEWS.pod deleted file mode 100755 index 217fe4a6fcc..00000000000 --- a/Master/tlpkg/tlperl/site/lib/Win32/OLE/NEWS.pod +++ /dev/null @@ -1,380 +0,0 @@ -=pod - -=head1 NAME - -Win32::OLE::NEWS - What's new in Win32::OLE - -This file contains a history of user visible changes to the -Win32::OLE::* modules. Only new features and major bug fixes that -might affect backwards compatibility are included. - -=head1 Version 0.18 - -=head2 VT_CY and VT_DECIMAL return values handled differently - -The new C<Variant> option enables values of VT_CY or VT_DECIMAL type -to be returned as Win32::OLE::Variant objects instead of being -converted into strings and numbers respectively. This is similar to -the change in Win32::OLE version 0.12 to VT_DATE and VT_ERROR values. -The Win32::OLE::Variant module must be included to make sure that -VT_CY and VT_DECIMAL values behave as before in numeric or string -contexts. - -Because the new behavior is potentially incompatible, it must be -explicitly enabled: - - Win32::OLE->Option(Variant => 1); - - -=head1 Version 0.17 - -=head2 New nullstring() function in Win32::OLE::Variant - -The nullstring() function returns a VT_BSTR variant containing a NULL -string pointer. Note that this is not the same as a VT_BSTR variant -containing the empty string "". - -The nullstring() return value is equivalent to the Visual Basic -C<vbNullString> constant. - - -=head1 Version 0.16 - -=head2 Improved Unicode support - -Passing Unicode strings to methods and properties as well as returning -Unicode strings back to Perl works now with both Perl 5.6 and 5.8. -Note that the Unicode support in 5.8 is much more complete than in 5.6 -or 5.6.1. - -C<Unicode::String> objects can now be passed to methods or assigned to -properties. - -You must enable Unicode support by switching Win32::OLE to the UTF8 -codepage: - - Win32::OLE->Option(CP => Win32::OLE::CP_UTF8()); - - -=head1 Version 0.13 - -=head2 New nothing() function in Win32::OLE::Variant - -The nothing() function returns an empty VT_DISPATCH variant. It can be -used to clear an object reference stored in a property - - use Win32::OLE::Variant qw(:DEFAULT nothing); - # ... - $object->{Property} = nothing; - -This has the same effect as the Visual Basic statement - - Set object.Property = Nothing - -=head2 New _NewEnum and _Unique options - -There are two new options available for the Win32::OLE->Option class -method: C<_NewEnum> provides the elements of a collection object -directly as the value of a C<_NewEnum> property. The C<_Unique> -option guarantees that Win32::OLE will not create multiple proxy -objects for the same underlying COM/OLE object. - -Both options are only really useful to tree traversal programs or -during debugging. - - -=head1 Version 0.12 - -=head2 Additional error handling functionality - -The Warn option can now be set to a CODE reference too. For example, - - Win32::OLE->Option(Warn => 3); - -could now be written as - - Win32::OLE->Option(Warn => \&Carp::croak); - -This can even be used to emulate the VisualBasic C<On Error Goto -Label> construct: - - Win32::OLE->Option(Warn => sub {goto CheckError}); - # ... your normal OLE code here ... - - CheckError: - # ... your error handling code here ... - -=head2 Builtin event loop - -Processing OLE events required a polling loop before, e.g. - - my $Quit; - #... - until ($Quit) { - Win32::OLE->SpinMessageLoop; - Win32::Sleep(100); - } - package BrowserEvents; - sub OnQuit { $Quit = 1 } - -This is inefficient and a bit odd. This version of Win32::OLE now -supports a standard messageloop: - - Win32::OLE->MessageLoop(); - - package BrowserEvents; - sub OnQuit { Win32::OLE->QuitMessageLoop } - -=head2 Free unused OLE libraries - -Previous versions of Win32::OLE would call the CoFreeUnusedLibraries() -API whenever an OLE object was destroyed. This made sure that OLE -libraries would be unloaded as soon as they were no longer needed. -Unfortunately, objects implemented in Visual Basic tend to crash -during this call, as they pretend to be ready for unloading, when in -fact, they aren't. - -The unloading of object libraries is really only important for long -running processes that might instantiate a huge number of B<different> -objects over time. Therefore this API is no longer called -automatically. The functionality is now available explicitly to those -who want or need it by calling a Win32::OLE class method: - - Win32::OLE->FreeUnusedLibraries(); - -=head2 The "Win32::OLE" article from "The Perl Journal #10" - -The article is Copyright 1998 by I<The Perl -Journal>. http://www.tpj.com - -It originally appeared in I<The Perl Journal> # 10 and appears here -courtesy of Jon Orwant and I<The Perl Journal>. The sample code from -the article is in the F<eg/tpj.pl> file. - -=head2 VARIANT->Put() bug fixes - -The Put() method didn't work correctly for arrays of type VT_BSTR, -VT_DISPATH or VT_UNKNOWN. This has been fixed. - -=head2 Error message fixes - -Previous versions of Win32::OLE gave a wrong argument index for some -OLE error messages (the number was too large by 1). This should be -fixed now. - -=head2 VT_DATE and VT_ERROR return values handled differently - -Method calls and property accesses returning a VT_DATE or VT_ERROR -value would previously translate the value to string or integer -format. This has been changed to return a Win32::OLE::Variant object. -The return values will behave as before if the Win32::OLE::Variant -module is being used. This module overloads the conversion of -the objects to strings and numbers. - - -=head1 Version 0.11 (changes since 0.1008) - -=head2 new DHTML typelib browser - -The Win32::OLE distribution now contains a type library browser. It -is written in PerlScript, generating dynamic HTML. It requires -Internet Explorer 4.0 or later. You'll find it in -F<browser/Browser.html>. It should be available in the ActivePerl -HTML help under Win32::OLE::Browser. - -After selecting a library, type or member you can press F1 to call up -the corresponding help file at the appropriate location. - -=head2 VT_DECIMAL support - -The Win32::OLE::Variant module now supports VT_DECIMAL variants too. -They are not "officially" allowed in OLE Automation calls, but even -Microsoft's "ActiveX Data Objects" sometimes returns VT_DECIMAL -values. - -VT_DECIMAL variables are stored as 96-bit integers scaled by a -variable power of 10. The power of 10 scaling factor specifies the -number of digits to the right of the decimal point, and ranges from 0 -to 28. With a scale of 0 (no decimal places), the largest possible -value is +/-79,228,162,514,264,337,593,543,950,335. With a 28 decimal -places, the largest value is +/-7.9228162514264337593543950335 and the -smallest, non-zero value is +/-0.0000000000000000000000000001. - -=head1 Version 0.1008 - -=head2 new LetProperty() object method - -In Win32::OLE property assignment using the hash syntax is equivalent -to the Visual Basic C<Set> syntax (I<by reference> assignment): - - $Object->{Property} = $OtherObject; - -corresponds to this Visual Basic statement: - - Set Object.Property = OtherObject - -To get the I<by value> treatment of the Visual Basic C<Let> statement - - Object.Property = OtherObject - -you have to use the LetProperty() object method in Perl: - - $Object->LetProperty($Property, $OtherObject); - -=head2 new HRESULT() function - -The HRESULT() function converts an unsigned number into a signed HRESULT -error value as used by OLE internally. This is necessary because Perl -treats all hexadecimal constants as unsigned. To check if the last OLE -function returned "Member not found" (0x80020003) you can write: - - if (Win32::OLE->LastError == HRESULT(0x80020003)) { - # your error recovery here - } - -=head1 Version 0.1007 (changes since 0.1005) - -=head2 OLE Event support - -This version of Win32::OLE contains B<ALPHA> level support for OLE events. The -user interface is still subject to change. There are ActiveX objects / controls -that don't fire events under the current implementation. - -Events are enabled for a specific object with the Win32::OLE->WithEvents() -class method: - - Win32::OLE->WithEvents(OBJECT, HANDLER, INTERFACE) - -Please read further documentation in Win32::OLE. - -=head2 GetObject() and GetActiveObject() now support optional DESTRUCTOR argument - -It is now possible to specify a DESTRUCTOR argument to the GetObject() and -GetActiveObject() class methods. They work identical to the new() DESTRUCTOR -argument. - -=head2 Remote object instantiation via DCOM - -This has actually been in Win32::OLE since 0.0608, but somehow never got -documented. You can provide an array reference in place of the usual PROGID -parameter to Win32::OLE->new(): - - OBJ = Win32::OLE->new([MACHINE, PRODID]); - -The array must contain two elements: the name of the MACHINE and the PROGID. -This will try to create the object on the remote MACHINE. - -=head2 Enumerate all Win32::OLE objects - -This class method returns the number Win32::OLE objects currently in -existence. It will call the optional CALLBACK function for each of -these objects: - - $Count = Win32::OLE->EnumAllObjects(sub { - my $Object = shift; - my $Class = Win32::OLE->QueryObjectType($Object); - printf "# Object=%s Class=%s\n", $Object, $Class; - }); - -The EnumAllObjects() method is primarily a debugging tool. It can be -used e.g. in an END block to check if all external connections have -been properly destroyed. - -=head2 The VARIANT->Put() method now returns the VARIANT object itself - -This allows chaining of Put() method calls to set multiple values in an -array variant: - - $Array->Put(0,0,$First_value)->Put(0,1,$Another_value); - -=head2 The VARIANT->Put(ARRAYREF) form allows assignment to a complete SAFEARRAY - -This allows automatic conversion from a list of lists to a SAFEARRAY. -You can now write: - - my $Array = Variant(VT_ARRAY|VT_R8, [1,2], 2); - $Array->Put([[1,2], [3,4]]); - -instead of the tedious: - - $Array->Put(1,0,1); - $Array->Put(1,1,2); - $Array->Put(2,0,3); - $Array->Put(2,1,4); - -=head2 New Variant formatting methods - -There are four new methods for formatting variant values: Currency(), Date(), -Number() and Time(). For example: - - my $v = Variant(VT_DATE, "April 1 99"); - print $v->Date(DATE_LONGDATE), "\n"; - print $v->Date("ddd',' MMM dd yy"), "\n"; - -will print: - - Thursday, April 01, 1999 - Thu, Apr 01 99 - -=head2 new Win32::OLE::NLS methods: SendSettingChange() and SetLocaleInfo() - -SendSettingChange() sends a WM_SETTINGCHANGE message to all top level windows. - -SetLocaleInfo() allows changing elements in the user override section of the -locale database. Unfortunately these changes are not automatically available -to further Variant formatting; you have to call SendSettingChange() first. - -=head2 Win32::OLE::Const now correctly treats version numbers as hex - -The minor and major version numbers of type libraries have been treated as -decimal. This was wrong. They are now correctly decoded as hex. - -=head2 more robust global destruction of Win32::OLE objects - -The final destruction of Win32::OLE objects has always been somewhat fragile. -The reason for this is that Perl doesn't honour reference counts during global -destruction but destroys objects in seemingly random order. This can lead -to leaked database connections or unterminated external objects. The only -solution was to make all objects lexical and hope that no object would be -trapped in a closure. Alternatively all objects could be explicitly set to -C<undef>, which doesn't work very well with exception handling. - -With version 0.1007 of Win32::OLE this problem should be gone: The module -keeps a list of active Win32::OLE objects. It uses an END block to destroy -all objects at program termination I<before> the Perl's global destruction -starts. Objects still existing at program termination are now destroyed in -reverse order of creation. The effect is similar to explicitly calling -Win32::OLE->Uninitialize() just prior to termination. - -=head1 Version 0.1005 (changes since 0.1003) - -Win32::OLE 0.1005 has been release with ActivePerl build 509. It is also -included in the I<Perl Resource Kit for Win32> Update. - -=head2 optional DESTRUCTOR for GetActiveObject() GetObject() class methods - -The GetActiveObject() and GetObject() class method now also support an -optional DESTRUCTOR parameter just like Win32::OLE->new(). The DESTRUCTOR -is executed when the last reference to this object goes away. It is -generally considered C<impolite> to stop applications that you did not -start yourself. - -=head2 new Variant object method: $object->Copy() - -See L<Win32::OLE::Variant/Copy([DIM])>. - -=head2 new Win32::OLE->Option() class method - -The Option() class method can be used to inspect and modify -L<Win32::OLE/Module Options>. The single argument form retrieves -the value of an option: - - my $CP = Win32::OLE->Option('CP'); - -A single call can be used to set multiple options simultaneously: - - Win32::OLE->Option(CP => CP_ACP, Warn => 3); - -Currently the following options exist: CP, LCID and C<Warn>. - -=cut diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/NLS.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE/NLS.pm deleted file mode 100755 index 84ea0c77241..00000000000 --- a/Master/tlpkg/tlperl/site/lib/Win32/OLE/NLS.pm +++ /dev/null @@ -1,968 +0,0 @@ -# The documentation is at the __END__ - -package Win32::OLE::NLS; -require Win32::OLE; # Make sure the XS bootstrap has been called - -use strict; -use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAGS @ISA); - -use Exporter; -@ISA = qw(Exporter); - -@EXPORT = qw( - CompareString - LCMapString - GetLocaleInfo - GetStringType - GetSystemDefaultLangID - GetSystemDefaultLCID - GetUserDefaultLangID - GetUserDefaultLCID - - MAKELANGID - PRIMARYLANGID - SUBLANGID - LANG_SYSTEM_DEFAULT - LANG_USER_DEFAULT - MAKELCID - LANGIDFROMLCID - LOCALE_SYSTEM_DEFAULT - LOCALE_USER_DEFAULT - ); - -@EXPORT_OK = qw(SetLocaleInfo SendSettingChange); - -%EXPORT_TAGS = -( - CT => [qw(CT_CTYPE1 CT_CTYPE2 CT_CTYPE3)], - C1 => [qw(C1_UPPER C1_LOWER C1_DIGIT C1_SPACE C1_PUNCT - C1_CNTRL C1_BLANK C1_XDIGIT C1_ALPHA)], - C2 => [qw(C2_LEFTTORIGHT C2_RIGHTTOLEFT C2_EUROPENUMBER - C2_EUROPESEPARATOR C2_EUROPETERMINATOR C2_ARABICNUMBER - C2_COMMONSEPARATOR C2_BLOCKSEPARATOR C2_SEGMENTSEPARATOR - C2_WHITESPACE C2_OTHERNEUTRAL C2_NOTAPPLICABLE)], - C3 => [qw(C3_NONSPACING C3_DIACRITIC C3_VOWELMARK C3_SYMBOL C3_KATAKANA - C3_HIRAGANA C3_HALFWIDTH C3_FULLWIDTH C3_IDEOGRAPH C3_KASHIDA - C3_ALPHA C3_NOTAPPLICABLE)], - NORM => [qw(NORM_IGNORECASE NORM_IGNORENONSPACE NORM_IGNORESYMBOLS - NORM_IGNOREWIDTH NORM_IGNOREKANATYPE NORM_IGNOREKASHIDA)], - LCMAP => [qw(LCMAP_LOWERCASE LCMAP_UPPERCASE LCMAP_SORTKEY LCMAP_HALFWIDTH - LCMAP_FULLWIDTH LCMAP_HIRAGANA LCMAP_KATAKANA)], - LANG => [qw(LANG_NEUTRAL LANG_ALBANIAN LANG_ARABIC LANG_BAHASA - LANG_BULGARIAN LANG_CATALAN LANG_CHINESE LANG_CZECH LANG_DANISH - LANG_DUTCH LANG_ENGLISH LANG_FINNISH LANG_FRENCH LANG_GERMAN - LANG_GREEK LANG_HEBREW LANG_HUNGARIAN LANG_ICELANDIC - LANG_ITALIAN LANG_JAPANESE LANG_KOREAN LANG_NORWEGIAN - LANG_POLISH LANG_PORTUGUESE LANG_RHAETO_ROMAN LANG_ROMANIAN - LANG_RUSSIAN LANG_SERBO_CROATIAN LANG_SLOVAK LANG_SPANISH - LANG_SWEDISH LANG_THAI LANG_TURKISH LANG_URDU)], - SUBLANG => [qw(SUBLANG_NEUTRAL SUBLANG_DEFAULT SUBLANG_SYS_DEFAULT - SUBLANG_CHINESE_SIMPLIFIED SUBLANG_CHINESE_TRADITIONAL - SUBLANG_DUTCH SUBLANG_DUTCH_BELGIAN SUBLANG_ENGLISH_US - SUBLANG_ENGLISH_UK SUBLANG_ENGLISH_AUS SUBLANG_ENGLISH_CAN - SUBLANG_ENGLISH_NZ SUBLANG_ENGLISH_EIRE SUBLANG_FRENCH - SUBLANG_FRENCH_BELGIAN SUBLANG_FRENCH_CANADIAN - SUBLANG_FRENCH_SWISS SUBLANG_GERMAN SUBLANG_GERMAN_SWISS - SUBLANG_GERMAN_AUSTRIAN SUBLANG_ITALIAN SUBLANG_ITALIAN_SWISS - SUBLANG_NORWEGIAN_BOKMAL SUBLANG_NORWEGIAN_NYNORSK - SUBLANG_PORTUGUESE SUBLANG_PORTUGUESE_BRAZILIAN - SUBLANG_SERBO_CROATIAN_CYRILLIC SUBLANG_SERBO_CROATIAN_LATIN - SUBLANG_SPANISH SUBLANG_SPANISH_MEXICAN - SUBLANG_SPANISH_MODERN)], - CTRY => [qw(CTRY_DEFAULT CTRY_AUSTRALIA CTRY_AUSTRIA CTRY_BELGIUM - CTRY_BRAZIL CTRY_CANADA CTRY_DENMARK CTRY_FINLAND CTRY_FRANCE - CTRY_GERMANY CTRY_ICELAND CTRY_IRELAND CTRY_ITALY CTRY_JAPAN - CTRY_MEXICO CTRY_NETHERLANDS CTRY_NEW_ZEALAND CTRY_NORWAY - CTRY_PORTUGAL CTRY_PRCHINA CTRY_SOUTH_KOREA CTRY_SPAIN - CTRY_SWEDEN CTRY_SWITZERLAND CTRY_TAIWAN CTRY_UNITED_KINGDOM - CTRY_UNITED_STATES)], - LOCALE => [qw(LOCALE_NOUSEROVERRIDE LOCALE_ILANGUAGE LOCALE_SLANGUAGE - LOCALE_SENGLANGUAGE LOCALE_SABBREVLANGNAME - LOCALE_SNATIVELANGNAME LOCALE_ICOUNTRY LOCALE_SCOUNTRY - LOCALE_SENGCOUNTRY LOCALE_SABBREVCTRYNAME LOCALE_SNATIVECTRYNAME - LOCALE_IDEFAULTLANGUAGE LOCALE_IDEFAULTCOUNTRY - LOCALE_IDEFAULTCODEPAGE LOCALE_IDEFAULTANSICODEPAGE LOCALE_SLIST - LOCALE_IMEASURE LOCALE_SDECIMAL LOCALE_STHOUSAND - LOCALE_SGROUPING LOCALE_IDIGITS LOCALE_ILZERO LOCALE_INEGNUMBER - LOCALE_SNATIVEDIGITS LOCALE_SCURRENCY LOCALE_SINTLSYMBOL - LOCALE_SMONDECIMALSEP LOCALE_SMONTHOUSANDSEP LOCALE_SMONGROUPING - LOCALE_ICURRDIGITS LOCALE_IINTLCURRDIGITS LOCALE_ICURRENCY - LOCALE_INEGCURR LOCALE_SDATE LOCALE_STIME LOCALE_SSHORTDATE - LOCALE_SLONGDATE LOCALE_STIMEFORMAT LOCALE_IDATE LOCALE_ILDATE - LOCALE_ITIME LOCALE_ITIMEMARKPOSN LOCALE_ICENTURY LOCALE_ITLZERO - LOCALE_IDAYLZERO LOCALE_IMONLZERO LOCALE_S1159 LOCALE_S2359 - LOCALE_ICALENDARTYPE LOCALE_IOPTIONALCALENDAR - LOCALE_IFIRSTDAYOFWEEK LOCALE_IFIRSTWEEKOFYEAR LOCALE_SDAYNAME1 - LOCALE_SDAYNAME2 LOCALE_SDAYNAME3 LOCALE_SDAYNAME4 - LOCALE_SDAYNAME5 LOCALE_SDAYNAME6 LOCALE_SDAYNAME7 - LOCALE_SABBREVDAYNAME1 LOCALE_SABBREVDAYNAME2 - LOCALE_SABBREVDAYNAME3 LOCALE_SABBREVDAYNAME4 - LOCALE_SABBREVDAYNAME5 LOCALE_SABBREVDAYNAME6 - LOCALE_SABBREVDAYNAME7 LOCALE_SMONTHNAME1 LOCALE_SMONTHNAME2 - LOCALE_SMONTHNAME3 LOCALE_SMONTHNAME4 LOCALE_SMONTHNAME5 - LOCALE_SMONTHNAME6 LOCALE_SMONTHNAME7 LOCALE_SMONTHNAME8 - LOCALE_SMONTHNAME9 LOCALE_SMONTHNAME10 LOCALE_SMONTHNAME11 - LOCALE_SMONTHNAME12 LOCALE_SMONTHNAME13 LOCALE_SABBREVMONTHNAME1 - LOCALE_SABBREVMONTHNAME2 LOCALE_SABBREVMONTHNAME3 - LOCALE_SABBREVMONTHNAME4 LOCALE_SABBREVMONTHNAME5 - LOCALE_SABBREVMONTHNAME6 LOCALE_SABBREVMONTHNAME7 - LOCALE_SABBREVMONTHNAME8 LOCALE_SABBREVMONTHNAME9 - LOCALE_SABBREVMONTHNAME10 LOCALE_SABBREVMONTHNAME11 - LOCALE_SABBREVMONTHNAME12 LOCALE_SABBREVMONTHNAME13 - LOCALE_SPOSITIVESIGN LOCALE_SNEGATIVESIGN LOCALE_IPOSSIGNPOSN - LOCALE_INEGSIGNPOSN LOCALE_IPOSSYMPRECEDES LOCALE_IPOSSEPBYSPACE - LOCALE_INEGSYMPRECEDES LOCALE_INEGSEPBYSPACE)], - TIME => [qw(TIME_NOMINUTESORSECONDS TIME_NOSECONDS TIME_NOTIMEMARKER - TIME_FORCE24HOURFORMAT)], - DATE => [qw(DATE_SHORTDATE DATE_LONGDATE DATE_USE_ALT_CALENDAR - DATE_YEARMONTH DATE_LTRREADING DATE_RTLREADING)], -); - -foreach my $tag (keys %EXPORT_TAGS) { - push @EXPORT_OK, @{$EXPORT_TAGS{$tag}}; -} - -# Character Type Flags -sub CT_CTYPE1 { 0x0001 } -sub CT_CTYPE2 { 0x0002 } -sub CT_CTYPE3 { 0x0004 } - -# Character Type 1 Bits -sub C1_UPPER { 0x0001 } -sub C1_LOWER { 0x0002 } -sub C1_DIGIT { 0x0004 } -sub C1_SPACE { 0x0008 } -sub C1_PUNCT { 0x0010 } -sub C1_CNTRL { 0x0020 } -sub C1_BLANK { 0x0040 } -sub C1_XDIGIT { 0x0080 } -sub C1_ALPHA { 0x0100 } - -# Character Type 2 Bits -sub C2_LEFTTORIGHT { 0x1 } -sub C2_RIGHTTOLEFT { 0x2 } -sub C2_EUROPENUMBER { 0x3 } -sub C2_EUROPESEPARATOR { 0x4 } -sub C2_EUROPETERMINATOR { 0x5 } -sub C2_ARABICNUMBER { 0x6 } -sub C2_COMMONSEPARATOR { 0x7 } -sub C2_BLOCKSEPARATOR { 0x8 } -sub C2_SEGMENTSEPARATOR { 0x9 } -sub C2_WHITESPACE { 0xA } -sub C2_OTHERNEUTRAL { 0xB } -sub C2_NOTAPPLICABLE { 0x0 } - -# Character Type 3 Bits -sub C3_NONSPACING { 0x0001 } -sub C3_DIACRITIC { 0x0002 } -sub C3_VOWELMARK { 0x0004 } -sub C3_SYMBOL { 0x0008 } -sub C3_KATAKANA { 0x0010 } -sub C3_HIRAGANA { 0x0020 } -sub C3_HALFWIDTH { 0x0040 } -sub C3_FULLWIDTH { 0x0080 } -sub C3_IDEOGRAPH { 0x0100 } -sub C3_KASHIDA { 0x0200 } -sub C3_ALPHA { 0x8000 } -sub C3_NOTAPPLICABLE { 0x0 } - -# String Flags -sub NORM_IGNORECASE { 0x0001 } -sub NORM_IGNORENONSPACE { 0x0002 } -sub NORM_IGNORESYMBOLS { 0x0004 } -sub NORM_IGNOREWIDTH { 0x0008 } -sub NORM_IGNOREKANATYPE { 0x0040 } -sub NORM_IGNOREKASHIDA { 0x40000} - -# Locale Dependent Mapping Flags -sub LCMAP_LOWERCASE { 0x0100 } -sub LCMAP_UPPERCASE { 0x0200 } -sub LCMAP_SORTKEY { 0x0400 } -sub LCMAP_HALFWIDTH { 0x0800 } -sub LCMAP_FULLWIDTH { 0x1000 } -sub LCMAP_HIRAGANA { 0x2000 } -sub LCMAP_KATAKANA { 0x4000 } - -# Primary Language Identifier -sub LANG_NEUTRAL { 0x00 } -sub LANG_ALBANIAN { 0x1c } -sub LANG_ARABIC { 0x01 } -sub LANG_BAHASA { 0x21 } -sub LANG_BULGARIAN { 0x02 } -sub LANG_CATALAN { 0x03 } -sub LANG_CHINESE { 0x04 } -sub LANG_CZECH { 0x05 } -sub LANG_DANISH { 0x06 } -sub LANG_DUTCH { 0x13 } -sub LANG_ENGLISH { 0x09 } -sub LANG_FINNISH { 0x0b } -sub LANG_FRENCH { 0x0c } -sub LANG_GERMAN { 0x07 } -sub LANG_GREEK { 0x08 } -sub LANG_HEBREW { 0x0d } -sub LANG_HUNGARIAN { 0x0e } -sub LANG_ICELANDIC { 0x0f } -sub LANG_ITALIAN { 0x10 } -sub LANG_JAPANESE { 0x11 } -sub LANG_KOREAN { 0x12 } -sub LANG_NORWEGIAN { 0x14 } -sub LANG_POLISH { 0x15 } -sub LANG_PORTUGUESE { 0x16 } -sub LANG_RHAETO_ROMAN { 0x17 } -sub LANG_ROMANIAN { 0x18 } -sub LANG_RUSSIAN { 0x19 } -sub LANG_SERBO_CROATIAN { 0x1a } -sub LANG_SLOVAK { 0x1b } -sub LANG_SPANISH { 0x0a } -sub LANG_SWEDISH { 0x1d } -sub LANG_THAI { 0x1e } -sub LANG_TURKISH { 0x1f } -sub LANG_URDU { 0x20 } - -# Sublanguage Identifier -sub SUBLANG_NEUTRAL { 0x00 } -sub SUBLANG_DEFAULT { 0x01 } -sub SUBLANG_SYS_DEFAULT { 0x02 } -sub SUBLANG_CHINESE_SIMPLIFIED { 0x02 } -sub SUBLANG_CHINESE_TRADITIONAL { 0x01 } -sub SUBLANG_DUTCH { 0x01 } -sub SUBLANG_DUTCH_BELGIAN { 0x02 } -sub SUBLANG_ENGLISH_US { 0x01 } -sub SUBLANG_ENGLISH_UK { 0x02 } -sub SUBLANG_ENGLISH_AUS { 0x03 } -sub SUBLANG_ENGLISH_CAN { 0x04 } -sub SUBLANG_ENGLISH_NZ { 0x05 } -sub SUBLANG_ENGLISH_EIRE { 0x06 } -sub SUBLANG_FRENCH { 0x01 } -sub SUBLANG_FRENCH_BELGIAN { 0x02 } -sub SUBLANG_FRENCH_CANADIAN { 0x03 } -sub SUBLANG_FRENCH_SWISS { 0x04 } -sub SUBLANG_GERMAN { 0x01 } -sub SUBLANG_GERMAN_SWISS { 0x02 } -sub SUBLANG_GERMAN_AUSTRIAN { 0x03 } -sub SUBLANG_ITALIAN { 0x01 } -sub SUBLANG_ITALIAN_SWISS { 0x02 } -sub SUBLANG_NORWEGIAN_BOKMAL { 0x01 } -sub SUBLANG_NORWEGIAN_NYNORSK { 0x02 } -sub SUBLANG_PORTUGUESE { 0x02 } -sub SUBLANG_PORTUGUESE_BRAZILIAN { 0x01 } -sub SUBLANG_SERBO_CROATIAN_CYRILLIC { 0x02 } -sub SUBLANG_SERBO_CROATIAN_LATIN { 0x01 } -sub SUBLANG_SPANISH { 0x01 } -sub SUBLANG_SPANISH_MEXICAN { 0x02 } -sub SUBLANG_SPANISH_MODERN { 0x03 } - -# Country codes -sub CTRY_DEFAULT { 0 } -sub CTRY_AUSTRALIA { 61 } -sub CTRY_AUSTRIA { 43 } -sub CTRY_BELGIUM { 32 } -sub CTRY_BRAZIL { 55 } -sub CTRY_CANADA { 2 } -sub CTRY_DENMARK { 45 } -sub CTRY_FINLAND { 358 } -sub CTRY_FRANCE { 33 } -sub CTRY_GERMANY { 49 } -sub CTRY_ICELAND { 354 } -sub CTRY_IRELAND { 353 } -sub CTRY_ITALY { 39 } -sub CTRY_JAPAN { 81 } -sub CTRY_MEXICO { 52 } -sub CTRY_NETHERLANDS { 31 } -sub CTRY_NEW_ZEALAND { 64 } -sub CTRY_NORWAY { 47 } -sub CTRY_PORTUGAL { 351 } -sub CTRY_PRCHINA { 86 } -sub CTRY_SOUTH_KOREA { 82 } -sub CTRY_SPAIN { 34 } -sub CTRY_SWEDEN { 46 } -sub CTRY_SWITZERLAND { 41 } -sub CTRY_TAIWAN { 886 } -sub CTRY_UNITED_KINGDOM { 44 } -sub CTRY_UNITED_STATES { 1 } - -# Locale Types -sub LOCALE_NOUSEROVERRIDE { 0x80000000 } -sub LOCALE_ILANGUAGE { 0x0001 } -sub LOCALE_SLANGUAGE { 0x0002 } -sub LOCALE_SENGLANGUAGE { 0x1001 } -sub LOCALE_SABBREVLANGNAME { 0x0003 } -sub LOCALE_SNATIVELANGNAME { 0x0004 } -sub LOCALE_ICOUNTRY { 0x0005 } -sub LOCALE_SCOUNTRY { 0x0006 } -sub LOCALE_SENGCOUNTRY { 0x1002 } -sub LOCALE_SABBREVCTRYNAME { 0x0007 } -sub LOCALE_SNATIVECTRYNAME { 0x0008 } -sub LOCALE_IDEFAULTLANGUAGE { 0x0009 } -sub LOCALE_IDEFAULTCOUNTRY { 0x000A } -sub LOCALE_IDEFAULTCODEPAGE { 0x000B } -sub LOCALE_IDEFAULTANSICODEPAGE { 0x1004 } -sub LOCALE_SLIST { 0x000C } -sub LOCALE_IMEASURE { 0x000D } -sub LOCALE_SDECIMAL { 0x000E } -sub LOCALE_STHOUSAND { 0x000F } -sub LOCALE_SGROUPING { 0x0010 } -sub LOCALE_IDIGITS { 0x0011 } -sub LOCALE_ILZERO { 0x0012 } -sub LOCALE_INEGNUMBER { 0x1010 } -sub LOCALE_SNATIVEDIGITS { 0x0013 } -sub LOCALE_SCURRENCY { 0x0014 } -sub LOCALE_SINTLSYMBOL { 0x0015 } -sub LOCALE_SMONDECIMALSEP { 0x0016 } -sub LOCALE_SMONTHOUSANDSEP { 0x0017 } -sub LOCALE_SMONGROUPING { 0x0018 } -sub LOCALE_ICURRDIGITS { 0x0019 } -sub LOCALE_IINTLCURRDIGITS { 0x001A } -sub LOCALE_ICURRENCY { 0x001B } -sub LOCALE_INEGCURR { 0x001C } -sub LOCALE_SDATE { 0x001D } -sub LOCALE_STIME { 0x001E } -sub LOCALE_SSHORTDATE { 0x001F } -sub LOCALE_SLONGDATE { 0x0020 } -sub LOCALE_STIMEFORMAT { 0x1003 } -sub LOCALE_IDATE { 0x0021 } -sub LOCALE_ILDATE { 0x0022 } -sub LOCALE_ITIME { 0x0023 } -sub LOCALE_ITIMEMARKPOSN { 0x1005 } -sub LOCALE_ICENTURY { 0x0024 } -sub LOCALE_ITLZERO { 0x0025 } -sub LOCALE_IDAYLZERO { 0x0026 } -sub LOCALE_IMONLZERO { 0x0027 } -sub LOCALE_S1159 { 0x0028 } -sub LOCALE_S2359 { 0x0029 } -sub LOCALE_ICALENDARTYPE { 0x1009 } -sub LOCALE_IOPTIONALCALENDAR { 0x100B } -sub LOCALE_IFIRSTDAYOFWEEK { 0x100C } -sub LOCALE_IFIRSTWEEKOFYEAR { 0x100D } -sub LOCALE_SDAYNAME1 { 0x002A } -sub LOCALE_SDAYNAME2 { 0x002B } -sub LOCALE_SDAYNAME3 { 0x002C } -sub LOCALE_SDAYNAME4 { 0x002D } -sub LOCALE_SDAYNAME5 { 0x002E } -sub LOCALE_SDAYNAME6 { 0x002F } -sub LOCALE_SDAYNAME7 { 0x0030 } -sub LOCALE_SABBREVDAYNAME1 { 0x0031 } -sub LOCALE_SABBREVDAYNAME2 { 0x0032 } -sub LOCALE_SABBREVDAYNAME3 { 0x0033 } -sub LOCALE_SABBREVDAYNAME4 { 0x0034 } -sub LOCALE_SABBREVDAYNAME5 { 0x0035 } -sub LOCALE_SABBREVDAYNAME6 { 0x0036 } -sub LOCALE_SABBREVDAYNAME7 { 0x0037 } -sub LOCALE_SMONTHNAME1 { 0x0038 } -sub LOCALE_SMONTHNAME2 { 0x0039 } -sub LOCALE_SMONTHNAME3 { 0x003A } -sub LOCALE_SMONTHNAME4 { 0x003B } -sub LOCALE_SMONTHNAME5 { 0x003C } -sub LOCALE_SMONTHNAME6 { 0x003D } -sub LOCALE_SMONTHNAME7 { 0x003E } -sub LOCALE_SMONTHNAME8 { 0x003F } -sub LOCALE_SMONTHNAME9 { 0x0040 } -sub LOCALE_SMONTHNAME10 { 0x0041 } -sub LOCALE_SMONTHNAME11 { 0x0042 } -sub LOCALE_SMONTHNAME12 { 0x0043 } -sub LOCALE_SMONTHNAME13 { 0x100E } -sub LOCALE_SABBREVMONTHNAME1 { 0x0044 } -sub LOCALE_SABBREVMONTHNAME2 { 0x0045 } -sub LOCALE_SABBREVMONTHNAME3 { 0x0046 } -sub LOCALE_SABBREVMONTHNAME4 { 0x0047 } -sub LOCALE_SABBREVMONTHNAME5 { 0x0048 } -sub LOCALE_SABBREVMONTHNAME6 { 0x0049 } -sub LOCALE_SABBREVMONTHNAME7 { 0x004A } -sub LOCALE_SABBREVMONTHNAME8 { 0x004B } -sub LOCALE_SABBREVMONTHNAME9 { 0x004C } -sub LOCALE_SABBREVMONTHNAME10 { 0x004D } -sub LOCALE_SABBREVMONTHNAME11 { 0x004E } -sub LOCALE_SABBREVMONTHNAME12 { 0x004F } -sub LOCALE_SABBREVMONTHNAME13 { 0x100F } -sub LOCALE_SPOSITIVESIGN { 0x0050 } -sub LOCALE_SNEGATIVESIGN { 0x0051 } -sub LOCALE_IPOSSIGNPOSN { 0x0052 } -sub LOCALE_INEGSIGNPOSN { 0x0053 } -sub LOCALE_IPOSSYMPRECEDES { 0x0054 } -sub LOCALE_IPOSSEPBYSPACE { 0x0055 } -sub LOCALE_INEGSYMPRECEDES { 0x0056 } -sub LOCALE_INEGSEPBYSPACE { 0x0057 } - -# GetTimeFormat Flags -sub TIME_NOMINUTESORSECONDS { 0x0001 } -sub TIME_NOSECONDS { 0x0002 } -sub TIME_NOTIMEMARKER { 0x0004 } -sub TIME_FORCE24HOURFORMAT { 0x0008 } - -# GetDateFormat Flags -sub DATE_SHORTDATE { 0x0001 } -sub DATE_LONGDATE { 0x0002 } -sub DATE_USE_ALT_CALENDAR { 0x0004 } -sub DATE_YEARMONTH { 0x0008 } -sub DATE_LTRREADING { 0x0010 } -sub DATE_RTLREADING { 0x0020 } - -# Language Identifier Functions -sub MAKELANGID { my ($p,$s) = @_; (($s & 0xffff) << 10) | ($p & 0xffff); } -sub PRIMARYLANGID { my $lgid = shift; $lgid & 0x3ff; } -sub SUBLANGID { my $lgid = shift; ($lgid >> 10) & 0x3f; } - -sub LANG_SYSTEM_DEFAULT { MAKELANGID(LANG_NEUTRAL, SUBLANG_SYS_DEFAULT); } -sub LANG_USER_DEFAULT { MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT); } - -# Locale Identifier Functions -sub MAKELCID { my $lgid = shift; $lgid & 0xffff; } -sub LANGIDFROMLCID { my $lcid = shift; $lcid & 0xffff; } - -sub LOCALE_SYSTEM_DEFAULT { MAKELCID(LANG_SYSTEM_DEFAULT); } -sub LOCALE_USER_DEFAULT { MAKELCID(LANG_USER_DEFAULT); } - -1; - -__END__ - -=head1 NAME - -Win32::OLE::NLS - OLE National Language Support - -=head1 SYNOPSIS - - missing - -=head1 DESCRIPTION - -This module provides access to the national language support features -in the F<OLENLS.DLL>. - -=head2 Functions - -=over 8 - -=item CompareString(LCID,FLAGS,STR1,STR2) - -Compare STR1 and STR2 in the LCID locale. FLAGS indicate the character -traits to be used or ignored when comparing the two strings. - - NORM_IGNORECASE Ignore case - NORM_IGNOREKANATYPE Ignore hiragana/katakana character differences - NORM_IGNORENONSPACE Ignore accents, diacritics, and vowel marks - NORM_IGNORESYMBOLS Ignore symbols - NORM_IGNOREWIDTH Ignore character width - -Possible return values are: - - 0 Function failed - 1 STR1 is less than STR2 - 2 STR1 is equal to STR2 - 3 STR1 is greater than STR2 - -Note that you can subtract 2 from the return code to get values -comparable to the C<cmp> operator. - -=item LCMapString(LCID,FLAGS,STR) - -LCMapString translates STR using LCID dependent translation. -Flags contains a combination of the following options: - - LCMAP_LOWERCASE Lowercase - LCMAP_UPPERCASE Uppercase - LCMAP_HALFWIDTH Narrow characters - LCMAP_FULLWIDTH Wide characters - LCMAP_HIRAGANA Hiragana - LCMAP_KATAKANA Katakana - LCMAP_SORTKEY Character sort key - -The following normalization options can be combined with C<LCMAP_SORTKEY>: - - NORM_IGNORECASE Ignore case - NORM_IGNOREKANATYPE Ignore hiragana/katakana character differences - NORM_IGNORENONSPACE Ignore accents, diacritics, and vowel marks - NORM_IGNORESYMBOLS Ignore symbols - NORM_IGNOREWIDTH Ignore character width - -The return value is the translated string. - -=item GetLocaleInfo(LCID,LCTYPE) - -Retrieve locale setting LCTYPE from the locale specified by LCID. Use -LOCALE_NOUSEROVERRIDE | LCTYPE to always query the locale database. -Otherwise user changes to C<win.ini> through the windows control panel -take precedence when retrieving values for the system default locale. -See the documentation below for a list of valid LCTYPE values. - -The return value is the contents of the requested locale setting. - -=item GetStringType(LCID,TYPE,STR) - -Retrieve type information from locale LCID about each character in STR. -The requested TYPE can be one of the following 3 levels: - - CT_CTYPE1 ANSI C and POSIX type information - CT_CTYPE2 Text layout type information - CT_CTYPE3 Text processing type information - -The return value is a list of values, each of wich is a bitwise OR of -the applicable type bits from the corresponding table below: - - @ct = GetStringType(LOCALE_SYSTEM_DEFAULT, CT_CTYPE1, "String"); - -ANSI C and POSIX character type information: - - C1_UPPER Uppercase - C1_LOWER Lowercase - C1_DIGIT Decimal digits - C1_SPACE Space characters - C1_PUNCT Punctuation - C1_CNTRL Control characters - C1_BLANK Blank characters - C1_XDIGIT Hexadecimal digits - C1_ALPHA Any letter - -Text layout type information: - - C2_LEFTTORIGHT Left to right - C2_RIGHTTOLEFT Right to left - C2_EUROPENUMBER European number, European digit - C2_EUROPESEPARATOR European numeric separator - C2_EUROPETERMINATOR European numeric terminator - C2_ARABICNUMBER Arabic number - C2_COMMONSEPARATOR Common numeric separator - C2_BLOCKSEPARATOR Block separator - C2_SEGMENTSEPARATOR Segment separator - C2_WHITESPACE White space - C2_OTHERNEUTRAL Other neutrals - C2_NOTAPPLICABLE No implicit direction (e.g. ctrl codes) - -Text precessing type information: - - C3_NONSPACING Nonspacing mark - C3_DIACRITIC Diacritic nonspacing mark - C3_VOWELMARK Vowel nonspacing mark - C3_SYMBOL Symbol - C3_KATAKANA Katakana character - C3_HIRAGANA Hiragana character - C3_HALFWIDTH Narrow character - C3_FULLWIDTH Wide character - C3_IDEOGRAPH Ideograph - C3_ALPHA Any letter - C3_NOTAPPLICABLE Not applicable - - -=item GetSystemDefaultLangID() - -Returns the system default language identifier. - -=item GetSystemDefaultLCID() - -Returns the system default locale identifier. - -=item GetUserDefaultLangID() - -Returns the user default language identifier. - -=item GetUserDefaultLCID() - -Returns the user default locale identifier. - -=item SendSettingChange() - -Sends a WM_SETTINGCHANGE message to all top level windows. - -=item SetLocaleInfo(LCID, LCTYPE, LCDATA) - -Changes an item in the user override part of the locale setting LCID. -It doesn't change the system default database. The following LCTYPEs are -changeable: - - LOCALE_ICALENDARTYPE LOCALE_SDATE - LOCALE_ICURRDIGITS LOCALE_SDECIMAL - LOCALE_ICURRENCY LOCALE_SGROUPING - LOCALE_IDIGITS LOCALE_SLIST - LOCALE_IFIRSTDAYOFWEEK LOCALE_SLONGDATE - LOCALE_IFIRSTWEEKOFYEAR LOCALE_SMONDECIMALSEP - LOCALE_ILZERO LOCALE_SMONGROUPING - LOCALE_IMEASURE LOCALE_SMONTHOUSANDSEP - LOCALE_INEGCURR LOCALE_SNEGATIVESIGN - LOCALE_INEGNUMBER LOCALE_SPOSITIVESIGN - LOCALE_IPAPERSIZE LOCALE_SSHORTDATE - LOCALE_ITIME LOCALE_STHOUSAND - LOCALE_S1159 LOCALE_STIME - LOCALE_S2359 LOCALE_STIMEFORMAT - LOCALE_SCURRENCY LOCALE_SYEARMONTH - -You have to call SendSettingChange() to activate these changes for -subsequent Win32::OLE::Variant object formatting because the OLE -subsystem seems to cache locale information. - -=item MAKELANGID(LANG,SUBLANG) - -Creates a language identifier from a primary language and a sublanguage. - -=item PRIMARYLANGID(LANGID) - -Retrieves the primary language from a language identifier. - -=item SUBLANGID(LANGID) - -Retrieves the sublanguage from a language identifier. - -=item MAKELCID(LANGID) - -Creates a locale identifies from a language identifier. - -=item LANGIDFROMLCID(LCID) - -Retrieves a language identifier from a locale identifier. - -=back - -=head2 Locale Types - -=over 8 - -=item LOCALE_ILANGUAGE - -The language identifier (in hex). - -=item LOCALE_SLANGUAGE - -The localized name of the language. - -=item LOCALE_SENGLANGUAGE - -The ISO Standard 639 English name of the language. - -=item LOCALE_SABBREVLANGNAME - -The three-letter abbreviated name of the language. The first two -letters are from the ISO Standard 639 language name abbreviation. The -third letter indicates the sublanguage type. - -=item LOCALE_SNATIVELANGNAME - -The native name of the language. - -=item LOCALE_ICOUNTRY - -The country code, which is based on international phone codes. - -=item LOCALE_SCOUNTRY - -The localized name of the country. - -=item LOCALE_SENGCOUNTRY - -The English name of the country. - -=item LOCALE_SABBREVCTRYNAME - -The ISO Standard 3166 abbreviated name of the country. - -=item LOCALE_SNATIVECTRYNAME - -The native name of the country. - -=item LOCALE_IDEFAULTLANGUAGE - -Language identifier for the principal language spoken in this -locale. - -=item LOCALE_IDEFAULTCOUNTRY - -Country code for the principal country in this locale. - -=item LOCALE_IDEFAULTANSICODEPAGE - -The ANSI code page associated with this locale. Format: 4 Unicode -decimal digits plus a Unicode null terminator. - -XXX This should be translated by GetLocaleInfo. XXX - -=item LOCALE_IDEFAULTCODEPAGE - -The OEM code page associated with the country. - -=item LOCALE_SLIST - -Characters used to separate list items (often a comma). - -=item LOCALE_IMEASURE - -Default measurement system: - - 0 metric system (S.I.) - 1 U.S. system - -=item LOCALE_SDECIMAL - -Characters used for the decimal separator (often a dot). - -=item LOCALE_STHOUSAND - -Characters used as the separator between groups of digits left of the decimal. - -=item LOCALE_SGROUPING - -Sizes for each group of digits to the left of the decimal. An explicit -size is required for each group. Sizes are separated by semicolons. If -the last value is 0, the preceding value is repeated. To group -thousands, specify 3;0. - -=item LOCALE_IDIGITS - -The number of fractional digits. - -=item LOCALE_ILZERO - -Whether to use leading zeros in decimal fields. A setting of 0 -means use no leading zeros; 1 means use leading zeros. - -=item LOCALE_SNATIVEDIGITS - -The ten characters that are the native equivalent of the ASCII 0-9. - -=item LOCALE_INEGNUMBER - -Negative number mode. - - 0 (1.1) - 1 -1.1 - 2 -1.1 - 3 1.1 - 4 1.1 - -=item LOCALE_SCURRENCY - -The string used as the local monetary symbol. - -=item LOCALE_SINTLSYMBOL - -Three characters of the International monetary symbol specified in ISO -4217, Codes for the Representation of Currencies and Funds, followed -by the character separating this string from the amount. - -=item LOCALE_SMONDECIMALSEP - -Characters used for the monetary decimal separators. - -=item LOCALE_SMONTHOUSANDSEP - -Characters used as monetary separator between groups of digits left of -the decimal. - -=item LOCALE_SMONGROUPING - -Sizes for each group of monetary digits to the left of the decimal. An -explicit size is needed for each group. Sizes are separated by -semicolons. If the last value is 0, the preceding value is -repeated. To group thousands, specify 3;0. - -=item LOCALE_ICURRDIGITS - -Number of fractional digits for the local monetary format. - -=item LOCALE_IINTLCURRDIGITS - -Number of fractional digits for the international monetary format. - -=item LOCALE_ICURRENCY - -Positive currency mode. - - 0 Prefix, no separation. - 1 Suffix, no separation. - 2 Prefix, 1-character separation. - 3 Suffix, 1-character separation. - -=item LOCALE_INEGCURR - -Negative currency mode. - - 0 ($1.1) - 1 -$1.1 - 2 $-1.1 - 3 $1.1- - 4 $(1.1$) - 5 -1.1$ - 6 1.1-$ - 7 1.1$- - 8 -1.1 $ (space before $) - 9 -$ 1.1 (space after $) - 10 1.1 $- (space before $) - -=item LOCALE_ICALENDARTYPE - -The type of calendar currently in use. - - 1 Gregorian (as in U.S.) - 2 Gregorian (always English strings) - 3 Era: Year of the Emperor (Japan) - 4 Era: Year of the Republic of China - 5 Tangun Era (Korea) - -=item LOCALE_IOPTIONALCALENDAR - -The additional calendar types available for this LCID. Can be a -null-separated list of all valid optional calendars. Value is -0 for "None available" or any of the LOCALE_ICALENDARTYPE settings. - -XXX null separated list should be translated by GetLocaleInfo XXX - -=item LOCALE_SDATE - -Characters used for the date separator. - -=item LOCALE_STIME - -Characters used for the time separator. - -=item LOCALE_STIMEFORMAT - -Time-formatting string. - -=item LOCALE_SSHORTDATE - -Short Date_Time formatting strings for this locale. - -=item LOCALE_SLONGDATE - -Long Date_Time formatting strings for this locale. - -=item LOCALE_IDATE - -Short Date format-ordering specifier. - - 0 Month - Day - Year - 1 Day - Month - Year - 2 Year - Month - Day - -=item LOCALE_ILDATE - -Long Date format ordering specifier. Value can be any of the valid -LOCALE_IDATE settings. - -=item LOCALE_ITIME - -Time format specifier. - - 0 AM/PM 12-hour format. - 1 24-hour format. - -=item LOCALE_ITIMEMARKPOSN - -Whether the time marker string (AM|PM) precedes or follows the time -string. - 0 Suffix (9:15 AM). - 1 Prefix (AM 9:15). - -=item LOCALE_ICENTURY - -Whether to use full 4-digit century. - - 0 Two digit. - 1 Full century. - -=item LOCALE_ITLZERO - -Whether to use leading zeros in time fields. - - 0 No leading zeros. - 1 Leading zeros for hours. - -=item LOCALE_IDAYLZERO - -Whether to use leading zeros in day fields. Values as for -LOCALE_ITLZERO. - -=item LOCALE_IMONLZERO - -Whether to use leading zeros in month fields. Values as for -LOCALE_ITLZERO. - -=item LOCALE_S1159 - -String for the AM designator. - -=item LOCALE_S2359 - -String for the PM designator. - -=item LOCALE_IFIRSTWEEKOFYEAR - -Specifies which week of the year is considered first. - - 0 Week containing 1/1 is the first week of the year. - 1 First full week following 1/1is the first week of the year. - 2 First week with at least 4 days is the first week of the year. - -=item LOCALE_IFIRSTDAYOFWEEK - -Specifies the day considered first in the week. Value "0" means -SDAYNAME1 and value "6" means SDAYNAME7. - -=item LOCALE_SDAYNAME1 .. LOCALE_SDAYNAME7 - -Long name for Monday .. Sunday. - -=item LOCALE_SABBREVDAYNAME1 .. LOCALE_SABBREVDAYNAME7 - -Abbreviated name for Monday .. Sunday. - -=item LOCALE_SMONTHNAME1 .. LOCALE_SMONTHNAME12 - -Long name for January .. December. - -=item LOCALE_SMONTHNAME13 - -Native name for 13th month, if it exists. - -=item LOCALE_SABBREVMONTHNAME1 .. LOCALE_SABBREVMONTHNAME12 - -Abbreviated name for January .. December. - -=item LOCALE_SABBREVMONTHNAME13 - -Native abbreviated name for 13th month, if it exists. - -=item LOCALE_SPOSITIVESIGN - -String value for the positive sign. - -=item LOCALE_SNEGATIVESIGN - -String value for the negative sign. - -=item LOCALE_IPOSSIGNPOSN - -Formatting index for positive values. - - 0 Parentheses surround the amount and the monetary symbol. - 1 The sign string precedes the amount and the monetary symbol. - 2 The sign string precedes the amount and the monetary symbol. - 3 The sign string precedes the amount and the monetary symbol. - 4 The sign string precedes the amount and the monetary symbol. - -=item LOCALE_INEGSIGNPOSN - -Formatting index for negative values. Values as for LOCALE_IPOSSIGNPOSN. - -=item LOCALE_IPOSSYMPRECEDES - -If the monetary symbol precedes, 1. If it succeeds a positive amount, 0. - -=item LOCALE_IPOSSEPBYSPACE - -If the monetary symbol is separated by a space from a positive amount, -1. Otherwise, 0. - -=item LOCALE_INEGSYMPRECEDES - -If the monetary symbol precedes, 1. If it succeeds a negative amount, 0. - -=item LOCALE_INEGSEPBYSPACE - -If the monetary symbol is separated by a space from a negative amount, -1. Otherwise, 0. - -=back - -=head1 AUTHORS/COPYRIGHT - -This module is part of the Win32::OLE distribution. - -=cut diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/TPJ.pod b/Master/tlpkg/tlperl/site/lib/Win32/OLE/TPJ.pod deleted file mode 100755 index e45770baa42..00000000000 --- a/Master/tlpkg/tlperl/site/lib/Win32/OLE/TPJ.pod +++ /dev/null @@ -1,798 +0,0 @@ -=pod - -=head1 NAME - -The Perl Journal #10 - Win32::OLE by Jan Dubois - -=head1 INTRODUCTION - -Suppose you're composing a document with Microsoft Word. You want to -include an Excel spreadsheet. You could save the spreadsheet in some -image format that Word can understand, and import it into your -document. But if the spreadsheet changes, your document will be out of -date. - -Microsoft's OLE (Object Linking and Embedding, pronounced "olay") lets -one program use objects from another. In the above scenario, the -spreadsheet is the object. As long as Excel makes that spreadsheet -available as an OLE object, and Word knows to treat it like one, your -document will always be current. - -You can control OLE objects from Perl with the Win32::OLE module, and -that's what this article is about. First, I'll show you how to "think -OLE," which mostly involves a lot of jargon. Next, I'll show you the -mechanics involved in using Win32::OLE. Then we'll go through a Perl -program that uses OLE to manipulate Microsoft Excel, Microsoft Access, -and Lotus Notes. Finally, I'll talk about Variants, an internal OLE -data type. - - -=head1 THE OLE MINDSET - -When an application makes an OLE object available for other -applications to use, that's called OLE I<automation>. The program -using the object is called the I<controller>, and the application -providing the object is called the I<server>. OLE automation is guided -by the OLE Component Object Model (COM) which specifies how those -objects must behave if they are to be used by other processes and -machines. - -There are two different types of OLE automation servers. I<In-process> -servers are implemented as dynamic link libraries (DLLs) and run in -the same process space as the controller. I<Out-of-process> servers -are more interesting; they are standalone executables that exist as -separate processes - possibly on a different computer. - -The Win32::OLE module lets your Perl program act as an OLE -controller. It allows Perl to be used in place of other languages like -Visual Basic or Java to control OLE objects. This makes all OLE -automation servers immediately available as Perl modules. - -Don't confuse ActiveState OLE with Win32::OLE. ActiveState OLE is -completely different, although future builds of ActiveState Perl (500 -and up) will work with Win32::OLE. - -Objects can expose OLE methods, properties, and events to the outside -world. Methods are functions that the controller can call to make the -object do something; properties describe the state of the object; and -events let the controller know about external events affecting the -object, such as the user clicking on a button. Since events involve -asynchronous communication with their objects, they require either -threads or an event loop. They are not yet supported by the Win32::OLE -module, and for the same reason ActiveX controls (OCXs) are currently -unsupported as well. - -=head1 WORKING WITH WIN32::OLE - -The Win32::OLE module doesn't let your Perl program create OLE -objects. What it does do is let your Perl program act like a remote -control for other applications-it lets your program be an OLE -controller. You can take an OLE object from another application -(Access, Notes, Excel, or anything else that speaks OLE) and invoke -its methods or manipulate its properties. - -=head2 THE FIRST STEP: CREATING AN OLE SERVER OBJECT - -First, we need to create a Perl object to represent the OLE -server. This is a weird idea; what it amounts to is that if we want to -control OLE objects produced by, say, Excel, we have to create a Perl -object that represents Excel. So even though our program is an OLE -controller, it'll contain objects that represent OLE servers. - -You can create a new OLE I<server object> with C<< Win32::OLE->new >>. -This takes a program ID (a human readable string like -C<'Speech.VoiceText'>) and returns a server object: - - my $server = Win32::OLE->new('Excel.Application', 'Quit'); - -Some server objects (particularly those for Microsoft Office -applications) don't automatically terminate when your program no -longer needs them. They need some kind of Quit method, and that's just -what our second argument is. It can be either a code reference or a -method name to be invoked when the object is destroyed. This lets you -ensure that objects will be properly cleaned up even when the Perl -program dies abnormally. - -To access a server object on a different computer, replace the first -argument with a reference to a list of the server name and program ID: - - my $server = Win32::OLE->new(['foo.bar.com', - 'Excel.Application']); - -(To get the requisite permissions, you'll need to configure your -security settings with F<DCOMCNFG.EXE>.) - -You can also directly attach your program to an already running OLE -server: - - my $server = Win32::OLE->GetActiveObject('Excel.Application'); - -This fails (returning C<undef>) if no server exists, or if the server -refuses the connection for some reason. It is also possible to use a -persistent object moniker (usually a filename) to start the associated -server and load the object into memory: - - my $doc = Win32::OLE->GetObject("MyDocument.Doc"); - -=head2 METHOD CALLS - -Once you've created one of these server objects, you need to call its -methods to make the OLE objects sing and dance. OLE methods are -invoked just like normal Perl object methods: - - $server->Foo(@Arguments); - -This is a Perl method call - but it also triggers an OLE method call -in the object. After your program executes this statement, the -C<$server> object will execute its Foo() method. The available methods -are typically documented in the application's I<object model>. - -B<Parameters.> By default, all parameters are positional -(e.g. C<foo($first, $second, $third)>) rather than named (e.g. -C<< foo(-name => "Yogi", -title => "Coach") >>). The required parameters -come first, followed by the optional parameters; if you need to -provide a dummy value for an optional parameter, use undef. - -Positional parameters get cumbersome if a method takes a lot of -them. You can use named arguments instead if you go to a little extra -trouble - when the last argument is a reference to a hash, the -key/value pairs of the hash are treated as named parameters: - - $server->Foo($Pos1, $Pos2, {Name1 => $Value1, - Name2 => $Value2}); - -B<Foreign Languages and Default Methods.> Sometimes OLE servers use -method and property names that are specific to a non-English -locale. That means they might have non-ASCII characters, which aren't -allowed in Perl variable names. In German, you might see C<Öffnen> used -instead of C<Open>. In these cases, you can use the Invoke() method: - - $server->Invoke('Öffnen', @Arguments); - -This is necessary because C<< $Server->Öffnen(@Arguments) >> is a syntax -error in current versions of Perl. - -=head2 PROPERTIES - -As I said earlier, objects can expose three things to the outside -world: methods, properties, and events. We've covered methods, and -Win32::OLE can't handle events. That leaves properties. But as it -turns out, properties and events are largely interchangeable. Most -methods have corresponding properties, and vice versa. - -An object's properties can be accessed with a hash reference: - - $server->{Bar} = $value; - $value = $server->{Bar}; - -This example sets and queries the value of the property named -C<Bar>. You could also have called the object's Bar() method to -achieve the same effect: - - $value = $server->Bar; - -However, you can't write the first line as C<< $server->Bar = $value >>, -because you can't assign to the return value of a method call. In -Visual Basic, OLE automation distinguishes between assigning the name -of an object and assigning its value: - - Set Object = OtherObject - - Let Value = Object - -The C<Set> statement shown here makes C<Object> refer to the same object as -C<OtherObject>. The C<Let> statement copies the value instead. (The value of -an OLE object is what you get when you call the object's default -method. - -In Perl, saying C<< $server1 = $server2 >> always creates another reference, -just like the C<Set> in Visual Basic. If you want to assign the value -instead, use the valof() function: - - my $value = valof $server; - -This is equivalent to - - my $value = $server->Invoke(''); - -=head2 SAMPLE APPLICATION - -Let's look at how all of this might be used. In Listing: 1 you'll see -F<T-Bond.pl>, a program that uses Win32::OLE for an almost-real world -application. - -The developer of this application, Mary Lynch, is a financial futures -broker. Every afternoon, she connects to the Chicago Board of Trade -(CBoT) web site at http://www.cbot.com and collects the time and sales -information for U.S. T-bond futures. She wants her program to create a -chart that depicts the data in 15-minute intervals, and then she wants -to record the data in a database for later analysis. Then she wants -her program to send mail to her clients. - -Mary's program will use Microsoft Access as a database, Microsoft -Excel to produce the chart, and Lotus Notes to send the mail. It will -all be controlled from a single Perl program using OLE automation. In -this section, we'll go through T-Bond. pl step by step so you can see -how Win32::OLE lets you control these applications. - -=head2 DOWNLOADING A WEB PAGE WITH LWP - -However, Mary first needs to amass the raw T-bond data by having her -Perl program automatically download and parse a web page. That's the -perfect job for LWP, the libwww-perl bundle available on the CPAN. LWP -has nothing to do with OLE. But this is a real-world application, and -it's just what Mary needs to download her data from the Chicago Board -of Trade. - - use LWP::Simple; - my $URL = 'http://www.cbot.com/mplex/quotes/tsfut'; - my $text = get("$URL/tsf$Contract.htm"); - -She could also have used the Win32::Internet module: - - use Win32::Internet; - my $URL = 'http://www.cbot.com/mplex/quotes/tsfut'; - my $text = $Win32::Internet->new->FetchURL("$URL/tsf$Contract.htm"); - -Mary wants to condense the ticker data into 15 minute bars. She's -interested only in lines that look like this: - - 03/12/1998 US 98Mar 12116 15:28:34 Open - -A regular expression can be used to determine whether a line looks -like this. If it does, the regex can split it up into individual -fields. The price quoted above, C<12116>, really means 121 16/32, and -needs to be converted to 121.5. The data is then condensed into 15 -minute intervals and only the first, last, highest, and lowest price -during each interval are kept. The time series is stored in the array -C<@Bars>. Each entry in C<@Bars> is a reference to a list of 5 elements: -Time, Open, High, Low, and Close. - - foreach (split "\n", $text) { - # 03/12/1998 US 98Mar 12116 15:28:34 Open - my ($Date,$Price,$Hour,$Min,$Sec,$Ind) = - m|^\s*(\d+/\d+/\d+) # " 03/12/1998" - \s+US\s+\S+\s+(\d+) # " US 98Mar 12116" - \s+(\d+):(\d+):(\d+) # " 12:42:40" - \s*(.*)$|x; # " Ask" - next unless defined $Date; - $Day = $Date; - - # Convert from fractional to decimal format - $Price = int($Price/100) + ($Price%100)/32; - - # Round up time to next multiple of 15 minutes - my $NewTime = int(($Sec+$Min*60+$Hour*3600)/900+1)*900; - unless (defined $Time && $NewTime == $Time) { - push @Bars, [$hhmm, $Open, $High, $Low, $Close] - if defined $Time; - $Open = $High = $Low = $Close = undef; - $Time = $NewTime; - my $Hour = int($Time/3600); - $hhmm = sprintf "%02d:%02d", $Hour, $Time/60-$Hour*60; - } - - # Update 15 minute bar values - $Close = $Price; - $Open = $Price unless defined $Open; - $High = $Price unless defined $High && $High > $Price; - $Low = $Price unless defined $Low && $Low > $Price; - } - - die "No data found" unless defined $Time; - push @Bars, [$hhmm, $Open, $High, $Low, $Close]; - -=head2 MICROSOFT ACCESS - -Now that Mary has her T-bond quotes, she's ready to use Win32::OLE to -store them into a Microsoft Access database. This has the advantage -that she can copy the database to her lap-top and work with it on her -long New York commute. She's able to create an Access database as -follows: - - use Win32::ODBC; - use Win32::OLE; - - # Include the constants for the Microsoft Access - # "Data Access Object". - - use Win32::OLE::Const 'Microsoft DAO'; - - my $DSN = 'T-Bonds'; - my $Driver = 'Microsoft Access Driver (*.mdb)'; - my $Desc = 'US T-Bond Quotes'; - my $Dir = 'i:\tmp\tpj'; - my $File = 'T-Bonds.mdb'; - my $Fullname = "$Dir\\$File"; - - # Remove old database and dataset name - unlink $Fullname if -f $Fullname; - Win32::ODBC::ConfigDSN(ODBC_REMOVE_DSN, $Driver, "DSN=$DSN") - if Win32::ODBC::DataSources($DSN); - - # Create new database - my $Access = Win32::OLE->new('Access.Application', 'Quit'); - my $Workspace = $Access->DBEngine->CreateWorkspace('', 'Admin', ''); - my $Database = $Workspace->CreateDatabase($Fullname, dbLangGeneral); - - # Add new database name - Win32::ODBC::ConfigDSN(ODBC_ADD_DSN, $Driver, - "DSN=$DSN", "Description=$Desc", "DBQ=$Fullname", - "DEFAULTDIR=$Dir", "UID=", "PWD="); - -This uses Win32::ODBC (described in TPJ #9) to remove and create -F<T-Bonds.mdb>. This lets Mary use the same script on her workstation -and on her laptop even when the database is stored in different -locations on each. The program also uses Win32::OLE to make Microsoft -Access create an empty database. - -Every OLE server has some constants that your Perl program will need -to use, made accessible by the Win32::OLE::Const module. For instance, -to grab the Excel constants, say C<use Win32::OLE::Const 'Microsoft -Excel'>. - -In the above example, we imported the Data Access Object con-stants -just so we could use C<dbLangGeneral>. - -=head2 MICROSOFT EXCEL - -Now Mary uses Win32::OLE a second time, to have Microsoft Excel create -the chart shown below. - - Figure 1: T-Bond data generated by MicroSoft Excel via Win32::OLE - - # Start Excel and create new workbook with a single sheet - use Win32::OLE qw(in valof with); - use Win32::OLE::Const 'Microsoft Excel'; - use Win32::OLE::NLS qw(:DEFAULT :LANG :SUBLANG); - - my $lgid = MAKELANGID(LANG_ENGLISH, SUBLANG_DEFAULT); - $Win32::OLE::LCID = MAKELCID($lgid); - - $Win32::OLE::Warn = 3; - -Here, Mary sets the locale to American English, which lets her do -things like use American date formats (e.g. C<"12-30-98"> rather than -C<"30-12-98">) in her program. It will continue to work even when she's -visiting one of her international customers and has to run this -program on their computers. - -The value of C<$Win32::OLE::Warn> determines what happens when an OLE -error occurs. If it's 0, the error is ignored. If it's 2, or if it's 1 -and the script is running under C<-w>, the Win32::OLE module invokes -C<Carp::carp()>. If C<$Win32::OLE::Warn> is set to 3, C<Carp::croak()> -is invoked and the program dies immediately. - -Now the data can be put into an Excel spreadsheet to produce the -chart. The following section of the program launches Excel and creates -a new workbook with a single worksheet. It puts the column titles -('Time', 'Open', 'High', 'Low', and 'Close') in a bold font on the -first row of the sheet. The first column displays the timestamp in -I<hh:mm> format; the next four display prices. - - my $Excel = Win32::OLE->new('Excel.Application', 'Quit'); - $Excel->{SheetsInNewWorkbook} = 1; - my $Book = $Excel->Workbooks->Add; - my $Sheet = $Book->Worksheets(1); - $Sheet->{Name} = 'Candle'; - - # Insert column titles - my $Range = $Sheet->Range("A1:E1"); - $Range->{Value} = [qw(Time Open High Low Close)]; - $Range->Font->{Bold} = 1; - - $Sheet->Columns("A:A")->{NumberFormat} = "h:mm"; - # Open/High/Low/Close to be displayed in 32nds - $Sheet->Columns("B:E")->{NumberFormat} = "# ?/32"; - - # Add 15 minute data to spreadsheet - print "Add data\n"; - $Range = $Sheet->Range(sprintf "A2:E%d", 2+$#Bars); - $Range->{Value} = \@Bars; - -The last statement shows how to pass arrays to OLE objects. The -Win32::OLE module automatically translates each array reference to a -C<SAFEARRAY>, the internal OLE array data type. This translation first -determines the maximum nesting level used by the Perl array, and then -creates a C<SAFEARRAY> of the same dimension. The C<@Bars> array -already contains the data in the correct form for the spreadsheet: - - ([Time1, Open1, High1, Low1, Close1], - ... - [TimeN, OpenN, HighN, LowN, CloseN]) - -Now the table in the spreadsheet can be used to create a candle stick -chart from our bars. Excel automatically chooses the time axis labels -if they are selected before the chart is created: - - # Create candle stick chart as new object on worksheet - $Sheet->Range("A:E")->Select; - - my $Chart = $Book->Charts->Add; - $Chart->{ChartType} = xlStockOHLC; - $Chart->Location(xlLocationAsObject, $Sheet->{Name}); - # Excel bug: the old $Chart is now invalid! - $Chart = $Excel->ActiveChart; - -We can change the type of the chart from a separate sheet to a chart -object on the spreadsheet page with the C<< $Chart->Location >> -method. (This invalidates the chart object handle, which might be -considered a bug in Excel.) Fortunately, this new chart is still the -'active' chart, so an object handle to it can be reclaimed simply by -asking Excel. - -At this point, our chart still needs a title, the legend is -meaningless, and the axis has decimals instead of fractions. We can -fix those with the following code: - - # Add title, remove legend - with($Chart, HasLegend => 0, HasTitle => 1); - $Chart->ChartTitle->Characters->{Text} = "US T-Bond"; - - # Set up daily statistics - $Open = $Bars[0][1]; - $High = $Sheet->Evaluate("MAX(C:C)"); - $Low = $Sheet->Evaluate("MIN(D:D)"); - $Close = $Bars[$#Bars][4]; - -The with() function partially mimics the Visual Basic With statement, -but allows only property assignments. It's a convenient shortcut for -this: - - { # open new scope - my $Axis = $Chart->Axes(xlValue); - $Axis->{HasMajorGridlines} = 1; - $Axis->{HasMinorGridlines} = 1; - # etc ... - } - -The C<$High> and C<$Low> for the day are needed to determine the -minimum and maximum scaling levels. MIN and MAX are spreadsheet -functions, and aren't automatically available as methods. However, -Excel provides an Evaluate() method to calculate arbitrary spreadsheet -functions, so we can use that. - -We want the chart to show major gridlines at every fourth tick and -minor gridlines at every second tick. The minimum and maximum are -chosen to be whatever multiples of 1/16 we need to do that. - - # Change tickmark spacing from decimal to fractional - with($Chart->Axes(xlValue), - HasMajorGridlines => 1, - HasMinorGridlines => 1, - MajorUnit => 1/8, - MinorUnit => 1/16, - MinimumScale => int($Low*16)/16, - MaximumScale => int($High*16+1)/16 - ); - - # Fat candles with only 5% gaps - $Chart->ChartGroups(1)->{GapWidth} = 5; - - sub RGB { $_[0] | ($_[1] >> 8) | ($_[2] >> 16) } - - # White background with a solid border - - $Chart->PlotArea->Border->{LineStyle} = xlContinuous; - $Chart->PlotArea->Border->{Color} = RGB(0,0,0); - $Chart->PlotArea->Interior->{Color} = RGB(255,255,255); - - # Add 1 hour moving average of the Close series - my $MovAvg = $Chart->SeriesCollection(4)->Trendlines - ->Add({Type => xlMovingAvg, Period => 4}); - $MovAvg->Border->{Color} = RGB(255,0,0); - -Now the finished workbook can be saved to disk as -F<i:\tmp\tpj\data.xls>. That file most likely still exists from when the -program ran yesterday, so we'll remove it. (Otherwise, Excel would pop -up a dialog with a warning, because the SaveAs() method doesn't like -to overwrite files.) - - - # Save workbook to file my $Filename = 'i:\tmp\tpj\data.xls'; - unlink $Filename if -f $Filename; - $Book->SaveAs($Filename); - $Book->Close; - -=head2 ACTIVEX DATA OBJECTS - -Mary stores the daily prices in her T-bonds database, keeping the data -for the different contracts in separate tables. After creating an ADO -(ActiveX Data Object) connection to the database, she tries to connect -a record set to the table for the current contract. If this fails, she -assumes that the table doesn't exists yet and tries to create it: - - use Win32::OLE::Const 'Microsoft ActiveX Data Objects'; - - my $Connection = Win32::OLE->new('ADODB.Connection'); - my $Recordset = Win32::OLE->new('ADODB.Recordset'); - $Connection->Open('T-Bonds'); - - # Open a record set for the table of this contract - { - local $Win32::OLE::Warn = 0; - $Recordset->Open($Contract, $Connection, adOpenKeyset, - adLockOptimistic, adCmdTable); - } - - # Create table and index if it doesn't exist yet - if (Win32::OLE->LastError) { - $Connection->Execute(<<"SQL"); - CREATE TABLE $Contract - ( - Day DATETIME, - Open DOUBLE, High DOUBLE, Low DOUBLE, Close DOUBLE - ) - SQL - $Connection->Execute(<<"SQL"); - CREATE INDEX $Contract - ON $Contract (Day) WITH PRIMARY - SQL - $Recordset->Open($Contract, $Connection, adOpenKeyset, - adLockOptimistic, adCmdTable); - } - -C<$Win32::OLE::Warn> is temporarily set to zero, so that if -C<$Recordset->Open> fails, the failure will be recorded silently without -terminating the program. C<Win32::OLE->LastError> shows whether the Open -failed or not. C<LastError> returns the OLE error code in a numeric -context and the OLE error message in a string context, just like -Perl's C<$!> variable. - -Now Mary can add today's data: - - # Add new record to table - use Win32::OLE::Variant; - $Win32::OLE::Variant::LCID = $Win32::OLE::LCID; - - my $Fields = [qw(Day Open High Low Close)]; - my $Values = [Variant(VT_DATE, $Day), - $Open, $High, $Low, $Close]; - -Mary uses the Win32::OLE::Variant module to store C<$Day> as a date -instead of a mere string. She wants to make sure that it's stored as -an American-style date, so in the third line shown here she sets the -locale ID of the Win32::OLE::Variant module to match the Win32::OLE -module. (C<$Win32::OLE::LCID> had been set earlier to English, since -that's what the Chicago Board of Trade uses.) - - { - local $Win32::OLE::Warn = 0; - $Recordset->AddNew($Fields, $Values); - } - - # Replace existing record - if (Win32::OLE->LastError) { - $Recordset->CancelUpdate; - $Recordset->Close; - $Recordset->Open(<<"SQL", $Connection, adOpenDynamic); - SELECT * FROM $Contract - WHERE Day = #$Day# - SQL - $Recordset->Update($Fields, $Values); - } - - $Recordset->Close; - $Connection->Close; - -The program expects to be able to add a new record to the table. It -fails if a record for this date already exists, because the Day field -is the primary index and therefore must be unique. If an error occurs, -the update operation started by AddNew() must first be cancelled with -C<< $Recordset->CancelUpdate >>; otherwise the record set won't close. - -=head2 LOTUS NOTES - -Now Mary can use Lotus Notes to mail updates to all her customers -interested in the T-bond data. (Lotus Notes doesn't provide its -constants in the OLE type library, so Mary had to determine them by -playing around with LotusScript.) The actual task is quite simple: A -Notes session must be started, the mail database must be opened and -the mail message must be created. The body of the message is created -as a rich text field, which lets her mix formatted text with object -attachments. - -In her program, Mary extracts the email addresses from her customer -database and sends separate message to each. Here, we've simplified it -somewhat. - - sub EMBED_ATTACHMENT {1454;} # from LotusScript - - my $Notes = Win32::OLE->new('Notes.NotesSession'); - my $Database = $Notes->GetDatabase('', ''); - $Database->OpenMail; - my $Document = $Database->CreateDocument; - - $Document->{Form} = 'Memo'; - $Document->{SendTo} = ['Jon Orwant >orwant@tpj.com>', - 'Jan Dubois >jan.dubois@ibm.net>']; - $Document->{Subject} = "US T-Bonds Chart for $Day"; - - my $Body = $Document->CreateRichtextItem('Body'); - $Body->AppendText(<<"EOT"); - I\'ve attached the latest US T-Bond data and chart for $Day. - The daily statistics were: - - \tOpen\t$Open - \tHigh\t$High - \tLow\t$Low - \tClose\t$Close - - Kind regards, - - Mary - EOT - - $Body->EmbedObject(EMBED_ATTACHMENT, '', $Filename); - - $Document->Send(0); - -=head1 VARIANTS - -In this final section, I'll talk about Variants, which are the data -types that you use to talk to OLE objects. We talked about this line -earlier: - - my $Values = [Variant(VT_DATE, $Day), - $Open, $High, $Low, $Close]; - -Here, the Variant() function creates a Variant object, of type C<VT_DATE> -and with the value C<$Day>. Variants are similar in many ways to Perl -scalars. Arguments to OLE methods are transparently converted from -their internal Perl representation to Variants and back again by the -Win32::OLE module. - -OLE automation uses a generic C<VARIANT> data type to pass -parameters. This data type contains type information in addition to -the actual data value. Only the following data types are valid for OLE -automation: - - B<Data Type Meaning> - VT_EMPTY Not specified - VT_NULL Null - VT_I2 2 byte signed integer - VT_I4 4 byte signed integer - VT_R4 4 byte real - VT_R8 8 byte real - VT_CY Currency - VT_DATE Date - VT_BSTR Unicode string - VT_DISPATCH OLE automation interface - VT_ERROR Error - VT_BOOL Boolean - VT_VARIANT (only valid with VT_BYREF) - VT_UNKNOWN Generic COM interface - VT_UI1 Unsigned character - -The following two flags can also be used: - - VT_ARRAY Array of values - VT_BYREF Pass by reference (instead of by value) - -B<The Perl to Variant transformation.> The following conversions are -performed automatically whenever a Perl value must be translated into -a Variant: - - Perl value Variant - Integer values VT_I4 - Real values VT_R8 - Strings VT_BSTR - undef VT_ERROR (DISP_E_PARAMNOTFOUND) - Array reference VT_VARIANT | VT_ARRAY - Win32::OLE object VT_DISPATCH - Win32::OLE::Variant object Type of the Variant object - -What if your Perl value is a list of lists? Those can be irregularly -shaped in Perl; that is, the subsidiary lists needn't have the same -number of elements. In this case, the structure will be converted to a -"rectangular" C<SAFEARRAY> of Variants, with unused slots set to -C<VT_EMPTY>. Consider this Perl 2-D array: - - [ ["Perl" ], # one element - [1, 3.1215, undef] # three elements - ] - -This will be translated to a 2 by 3 C<SAFEARRAY> that looks like this: - - VT_BSTR("Perl") VT_EMPTY VT_EMPTY - VT_I4(1) VT_R8(3.1415) VT_ERROR(DISP_E_PARAMNOTFOUND) - -B<The Variant To Perl Transformation.> Automatic conversion from Variants -to Perl values happens as follows: - - Variant Perl value - VT_BOOL, VT_ERROR Integer - VT_UI1, VT_I2, VT_I4 Integer - VT_R4, VT_R8 Float value - VT_BSTR String - VT_DISPATCH Win32::OLE object - -B<The Win32::OLE::Variant module.> This module provides access to the -Variant data type, which gives you more control over how these -arguments to OLE methods are encoded. (This is rarely necessary if you -have a good grasp of the default conversion rules.) A Variant object -can be created with the C<< Win32::OLE::Variant->new >> method or the -equivalent Variant() function: - - use Win32::OLE::Variant; - my $var1 = Win32::OLE::Variant->new(VT_DATE, 'Jan 1,1970'); - my $var2 = Variant(VT_BSTR, 'This is an Unicode string'); - -Several methods let you inspect and manipulate Variant objects: The -Type() and Value() methods return the variant type and value; the As() -method returns the value after converting it to a different variant -type; ChangeType() coerces the Variant into a different type; and -Unicode() returns the value of a Variant object as an object of the -Unicode::String class. - -These conversions are more interesting if they can be applied directly -to the return value of an OLE method call without first mutilating the -value with default conversions. This is possible with the following -trick: - - my $RetVal = Variant(VT_EMPTY, undef); - $Object->Dispatch($Method, $RetVal, @Arguments); - -Normally, you wouldn't call Dispatch() directly; it's executed -implicitly by either AUTOLOAD() or Invoke(). If Dispatch() realizes -that the return value is already a Win32::OLE::Variant object, the -return value is not translated into a Perl representation but rather -copied verbatim into the Variant object. - -Whenever a Win32::OLE::Variant object is used in a numeric or string -context it is automatically converted into the corresponding format. - - printf "Number: %f and String: %s\n", - $Var, $Var; - -This is equivalent to: - - printf "Number: %f and String: %s\n", - $Var->As(VT_R8), $Var->As(VT_BSTR); - -For methods that modify their arguments, you need to use the C<VT_BYREF> -flag. This lets you create number and string Variants that can be -modified by OLE methods. Here, Corel's GetSize() method takes two -integers and stores the C<x> and C<y> dimensions in them: - - my $x = Variant( VT_I4 | VT_BYREF, 0); - my $y = Variant( VT_I4 | VT_BYREF, 0); - $Corel->GetSize($x, $y); - -C<VT_BYREF> support for other Variant types might appear in future -releases of Win32::OLE. - -=head1 FURTHER INFORMATION - -=head2 DOCUMENTATION AND EXAMPLE CODE - -More information about the OLE modules can be found in the -documentation bundled with Win32::OLE. The distribution also contains -other code samples. - -The object model for Microsoft Office applications can be found in the -Visual Basic Reference for Microsoft Access, Excel, Word, or -PowerPoint. These help files are not installed by default, but they -can be added later by rerunning F<setup.exe> and choosing I<custom -setup>. The object model for Microsoft Outlook can be found on the -Microsoft Office Developer Forum at: -http://www.microsoft.com/OutlookDev/. - -Information about the LotusScript object model can be found at: -http://www.lotus.com/products/lotusscript.nsf. - -=head2 OLE AUTOMATION ON OTHER PLATFORMS - -Microsoft also makes OLE technology available for the Mac. DCOM is -already included in Windows NT 4.0 and can be downloaded for Windows -95. MVS and some Unix systems can use EntireX to get OLE -functionality; see -http://www.softwareag.com/corporat/solutions/entirex/entirex.htm. - -=head1 COPYRIGHT - -Copyright 1998 I<The Perl Journal>. http://www.tpj.com - -This article originally appeared in I<The Perl Journal> #10. It -appears courtesy of Jon Orwant and I<The Perl Journal>. This document -may be distributed under the same terms as Perl itself. diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/TypeInfo.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE/TypeInfo.pm deleted file mode 100755 index d95399c1e29..00000000000 --- a/Master/tlpkg/tlperl/site/lib/Win32/OLE/TypeInfo.pm +++ /dev/null @@ -1,389 +0,0 @@ -# This module is still experimental and intentionally undocumented. -# If you don't know why it is here, then you should probably not use it. - -package Win32::OLE::TypeInfo; - -use strict; -use vars qw(@ISA @EXPORT @EXPORT_OK); -use vars qw(@VT %TYPEFLAGS @TYPEKIND %IMPLTYPEFLAGS %PARAMFLAGS - %FUNCFLAGS @CALLCONV @FUNCKIND %INVOKEKIND %VARFLAGS - %LIBFLAGS @SYSKIND); - -use Exporter; -@ISA = qw(Exporter); - -@EXPORT = qw( - VT_EMPTY VT_NULL VT_I2 VT_I4 VT_R4 VT_R8 VT_CY VT_DATE - VT_BSTR VT_DISPATCH VT_ERROR VT_BOOL VT_VARIANT VT_UNKNOWN - VT_DECIMAL VT_I1 VT_UI1 VT_UI2 VT_UI4 VT_I8 VT_UI8 VT_INT - VT_UINT VT_VOID VT_HRESULT VT_PTR VT_SAFEARRAY VT_CARRAY - VT_USERDEFINED VT_LPSTR VT_LPWSTR VT_FILETIME VT_BLOB - VT_STREAM VT_STORAGE VT_STREAMED_OBJECT VT_STORED_OBJECT - VT_BLOB_OBJECT VT_CF VT_CLSID VT_VECTOR VT_ARRAY VT_BYREF - VT_RESERVED VT_ILLEGAL VT_ILLEGALMASKED VT_TYPEMASK - - TYPEFLAG_FAPPOBJECT TYPEFLAG_FCANCREATE TYPEFLAG_FLICENSED - TYPEFLAG_FPREDECLID TYPEFLAG_FHIDDEN TYPEFLAG_FCONTROL - TYPEFLAG_FDUAL TYPEFLAG_FNONEXTENSIBLE TYPEFLAG_FOLEAUTOMATION - TYPEFLAG_FRESTRICTED TYPEFLAG_FAGGREGATABLE TYPEFLAG_FREPLACEABLE - TYPEFLAG_FDISPATCHABLE TYPEFLAG_FREVERSEBIND - - TKIND_ENUM TKIND_RECORD TKIND_MODULE TKIND_INTERFACE TKIND_DISPATCH - TKIND_COCLASS TKIND_ALIAS TKIND_UNION TKIND_MAX - - IMPLTYPEFLAG_FDEFAULT IMPLTYPEFLAG_FSOURCE IMPLTYPEFLAG_FRESTRICTED - IMPLTYPEFLAG_FDEFAULTVTABLE - - PARAMFLAG_NONE PARAMFLAG_FIN PARAMFLAG_FOUT PARAMFLAG_FLCID - PARAMFLAG_FRETVAL PARAMFLAG_FOPT PARAMFLAG_FHASDEFAULT - - FUNCFLAG_FRESTRICTED FUNCFLAG_FSOURCE FUNCFLAG_FBINDABLE - FUNCFLAG_FREQUESTEDIT FUNCFLAG_FDISPLAYBIND FUNCFLAG_FDEFAULTBIND - FUNCFLAG_FHIDDEN FUNCFLAG_FUSESGETLASTERROR FUNCFLAG_FDEFAULTCOLLELEM - FUNCFLAG_FUIDEFAULT FUNCFLAG_FNONBROWSABLE FUNCFLAG_FREPLACEABLE - FUNCFLAG_FIMMEDIATEBIND - - CC_FASTCALL CC_CDECL CC_MSCPASCAL CC_PASCAL CC_MACPASCAL CC_STDCALL - CC_FPFASTCALL CC_SYSCALL CC_MPWCDECL CC_MPWPASCAL CC_MAX - - INVOKE_FUNC INVOKE_PROPERTYGET INVOKE_PROPERTYPUT INVOKE_PROPERTYPUTREF - - VARFLAG_FREADONLY VARFLAG_FSOURCE VARFLAG_FBINDABLE VARFLAG_FREQUESTEDIT - VARFLAG_FDISPLAYBIND VARFLAG_FDEFAULTBIND VARFLAG_FHIDDEN VARFLAG_FRESTRICTED - VARFLAG_FDEFAULTCOLLELEM VARFLAG_FUIDEFAULT VARFLAG_FNONBROWSABLE - VARFLAG_FREPLACEABLE VARFLAG_FIMMEDIATEBIND - - LIBFLAG_FRESTRICTED LIBFLAG_FCONTROL LIBFLAG_FHIDDEN - SYS_WIN16 SYS_WIN32 SYS_MAC - - FUNC_VIRTUAL FUNC_PUREVIRTUAL FUNC_NONVIRTUAL FUNC_STATIC FUNC_DISPATCH - - @VT %TYPEFLAGS @TYPEKIND %IMPLTYPEFLAGS %PARAMFLAGS - %FUNCFLAGS @CALLCONV @FUNCKIND %INVOKEKIND %VARFLAGS %LIBFLAGS @SYSKIND -); - -# Lib Flags -# --------- - -sub LIBFLAG_FRESTRICTED () { 0x01; } -sub LIBFLAG_FCONTROL () { 0x02; } -sub LIBFLAG_FHIDDEN () { 0x04; } - -$LIBFLAGS{LIBFLAG_FRESTRICTED()} = LIBFLAG_FRESTRICTED; -$LIBFLAGS{LIBFLAG_FCONTROL()} = LIBFLAG_FCONTROL; -$LIBFLAGS{LIBFLAG_FHIDDEN()} = LIBFLAG_FHIDDEN; - -# Sys Kind -# -------- - -sub SYS_WIN16 () { 0; } -sub SYS_WIN32 () { SYS_WIN16() + 1; } -sub SYS_MAC () { SYS_WIN32() + 1; } - -$SYSKIND[SYS_WIN16] = 'SYS_WIN16'; -$SYSKIND[SYS_WIN32] = 'SYS_WIN32'; -$SYSKIND[SYS_MAC] = 'SYS_MAC'; - -# Type Flags -# ---------- - -sub TYPEFLAG_FAPPOBJECT () { 0x1; } -sub TYPEFLAG_FCANCREATE () { 0x2; } -sub TYPEFLAG_FLICENSED () { 0x4; } -sub TYPEFLAG_FPREDECLID () { 0x8; } -sub TYPEFLAG_FHIDDEN () { 0x10; } -sub TYPEFLAG_FCONTROL () { 0x20; } -sub TYPEFLAG_FDUAL () { 0x40; } -sub TYPEFLAG_FNONEXTENSIBLE () { 0x80; } -sub TYPEFLAG_FOLEAUTOMATION () { 0x100; } -sub TYPEFLAG_FRESTRICTED () { 0x200; } -sub TYPEFLAG_FAGGREGATABLE () { 0x400; } -sub TYPEFLAG_FREPLACEABLE () { 0x800; } -sub TYPEFLAG_FDISPATCHABLE () { 0x1000; } -sub TYPEFLAG_FREVERSEBIND () { 0x2000; } - -$TYPEFLAGS{TYPEFLAG_FAPPOBJECT()} = TYPEFLAG_FAPPOBJECT; -$TYPEFLAGS{TYPEFLAG_FCANCREATE()} = TYPEFLAG_FCANCREATE; -$TYPEFLAGS{TYPEFLAG_FLICENSED()} = TYPEFLAG_FLICENSED; -$TYPEFLAGS{TYPEFLAG_FPREDECLID()} = TYPEFLAG_FPREDECLID; -$TYPEFLAGS{TYPEFLAG_FHIDDEN()} = TYPEFLAG_FHIDDEN; -$TYPEFLAGS{TYPEFLAG_FCONTROL()} = TYPEFLAG_FCONTROL; -$TYPEFLAGS{TYPEFLAG_FDUAL()} = TYPEFLAG_FDUAL; -$TYPEFLAGS{TYPEFLAG_FNONEXTENSIBLE()} = TYPEFLAG_FNONEXTENSIBLE; -$TYPEFLAGS{TYPEFLAG_FOLEAUTOMATION()} = TYPEFLAG_FOLEAUTOMATION; -$TYPEFLAGS{TYPEFLAG_FRESTRICTED()} = TYPEFLAG_FRESTRICTED; -$TYPEFLAGS{TYPEFLAG_FAGGREGATABLE()} = TYPEFLAG_FAGGREGATABLE; -$TYPEFLAGS{TYPEFLAG_FREPLACEABLE()} = TYPEFLAG_FREPLACEABLE; -$TYPEFLAGS{TYPEFLAG_FDISPATCHABLE()} = TYPEFLAG_FDISPATCHABLE; -$TYPEFLAGS{TYPEFLAG_FREVERSEBIND()} = TYPEFLAG_FREVERSEBIND; - -# Type Kind -# --------- - -sub TKIND_ENUM () { 0; } -sub TKIND_RECORD () { TKIND_ENUM() + 1; } -sub TKIND_MODULE () { TKIND_RECORD() + 1; } -sub TKIND_INTERFACE () { TKIND_MODULE() + 1; } -sub TKIND_DISPATCH () { TKIND_INTERFACE() + 1; } -sub TKIND_COCLASS () { TKIND_DISPATCH() + 1; } -sub TKIND_ALIAS () { TKIND_COCLASS() + 1; } -sub TKIND_UNION () { TKIND_ALIAS() + 1; } -sub TKIND_MAX () { TKIND_UNION() + 1; } - -$TYPEKIND[TKIND_ENUM] = 'TKIND_ENUM'; -$TYPEKIND[TKIND_RECORD] = 'TKIND_RECORD'; -$TYPEKIND[TKIND_MODULE] = 'TKIND_MODULE'; -$TYPEKIND[TKIND_INTERFACE] = 'TKIND_INTERFACE'; -$TYPEKIND[TKIND_DISPATCH] = 'TKIND_DISPATCH'; -$TYPEKIND[TKIND_COCLASS] = 'TKIND_COCLASS'; -$TYPEKIND[TKIND_ALIAS] = 'TKIND_ALIAS'; -$TYPEKIND[TKIND_UNION] = 'TKIND_UNION'; - -# Implemented Type Flags -# ---------------------- - -sub IMPLTYPEFLAG_FDEFAULT () { 0x1; } -sub IMPLTYPEFLAG_FSOURCE () { 0x2; } -sub IMPLTYPEFLAG_FRESTRICTED () { 0x4; } -sub IMPLTYPEFLAG_FDEFAULTVTABLE () { 0x800; } - -$IMPLTYPEFLAGS{IMPLTYPEFLAG_FDEFAULT()} = IMPLTYPEFLAG_FDEFAULT; -$IMPLTYPEFLAGS{IMPLTYPEFLAG_FSOURCE()} = IMPLTYPEFLAG_FSOURCE; -$IMPLTYPEFLAGS{IMPLTYPEFLAG_FRESTRICTED()} = IMPLTYPEFLAG_FRESTRICTED; -$IMPLTYPEFLAGS{IMPLTYPEFLAG_FDEFAULTVTABLE()} = IMPLTYPEFLAG_FDEFAULTVTABLE; - -# Parameter Flags -# --------------- - -sub PARAMFLAG_NONE () { 0; } -sub PARAMFLAG_FIN () { 0x1; } -sub PARAMFLAG_FOUT () { 0x2; } -sub PARAMFLAG_FLCID () { 0x4; } -sub PARAMFLAG_FRETVAL () { 0x8; } -sub PARAMFLAG_FOPT () { 0x10; } -sub PARAMFLAG_FHASDEFAULT () { 0x20; } - -$PARAMFLAGS{PARAMFLAG_NONE()} = PARAMFLAG_NONE; -$PARAMFLAGS{PARAMFLAG_FIN()} = PARAMFLAG_FIN; -$PARAMFLAGS{PARAMFLAG_FOUT()} = PARAMFLAG_FOUT; -$PARAMFLAGS{PARAMFLAG_FLCID()} = PARAMFLAG_FLCID; -$PARAMFLAGS{PARAMFLAG_FRETVAL()} = PARAMFLAG_FRETVAL; -$PARAMFLAGS{PARAMFLAG_FOPT()} = PARAMFLAG_FOPT; -$PARAMFLAGS{PARAMFLAG_FHASDEFAULT()} = PARAMFLAG_FHASDEFAULT; - -# Function Flags -# -------------- - -sub FUNCFLAG_FRESTRICTED () { 0x1; } -sub FUNCFLAG_FSOURCE () { 0x2; } -sub FUNCFLAG_FBINDABLE () { 0x4; } -sub FUNCFLAG_FREQUESTEDIT () { 0x8; } -sub FUNCFLAG_FDISPLAYBIND () { 0x10; } -sub FUNCFLAG_FDEFAULTBIND () { 0x20; } -sub FUNCFLAG_FHIDDEN () { 0x40; } -sub FUNCFLAG_FUSESGETLASTERROR () { 0x80; } -sub FUNCFLAG_FDEFAULTCOLLELEM () { 0x100; } -sub FUNCFLAG_FUIDEFAULT () { 0x200; } -sub FUNCFLAG_FNONBROWSABLE () { 0x400; } -sub FUNCFLAG_FREPLACEABLE () { 0x800; } -sub FUNCFLAG_FIMMEDIATEBIND () { 0x1000; } - -$FUNCFLAGS{FUNCFLAG_FRESTRICTED()} = FUNCFLAG_FRESTRICTED; -$FUNCFLAGS{FUNCFLAG_FSOURCE()} = FUNCFLAG_FSOURCE; -$FUNCFLAGS{FUNCFLAG_FBINDABLE()} = FUNCFLAG_FBINDABLE; -$FUNCFLAGS{FUNCFLAG_FREQUESTEDIT()} = FUNCFLAG_FREQUESTEDIT; -$FUNCFLAGS{FUNCFLAG_FDISPLAYBIND()} = FUNCFLAG_FDISPLAYBIND; -$FUNCFLAGS{FUNCFLAG_FDEFAULTBIND()} = FUNCFLAG_FDEFAULTBIND; -$FUNCFLAGS{FUNCFLAG_FHIDDEN()} = FUNCFLAG_FHIDDEN; -$FUNCFLAGS{FUNCFLAG_FUSESGETLASTERROR()} = FUNCFLAG_FUSESGETLASTERROR; -$FUNCFLAGS{FUNCFLAG_FDEFAULTCOLLELEM()} = FUNCFLAG_FDEFAULTCOLLELEM; -$FUNCFLAGS{FUNCFLAG_FUIDEFAULT()} = FUNCFLAG_FUIDEFAULT; -$FUNCFLAGS{FUNCFLAG_FNONBROWSABLE()} = FUNCFLAG_FNONBROWSABLE; -$FUNCFLAGS{FUNCFLAG_FREPLACEABLE()} = FUNCFLAG_FREPLACEABLE; -$FUNCFLAGS{FUNCFLAG_FIMMEDIATEBIND()} = FUNCFLAG_FIMMEDIATEBIND; - -# Calling conventions -# ------------------- - -sub CC_FASTCALL () { 0; } -sub CC_CDECL () { 1; } -sub CC_MSCPASCAL () { CC_CDECL() + 1; } -sub CC_PASCAL () { CC_MSCPASCAL; } -sub CC_MACPASCAL () { CC_PASCAL() + 1; } -sub CC_STDCALL () { CC_MACPASCAL() + 1; } -sub CC_FPFASTCALL () { CC_STDCALL() + 1; } -sub CC_SYSCALL () { CC_FPFASTCALL() + 1; } -sub CC_MPWCDECL () { CC_SYSCALL() + 1; } -sub CC_MPWPASCAL () { CC_MPWCDECL() + 1; } -sub CC_MAX () { CC_MPWPASCAL() + 1; } - -$CALLCONV[CC_FASTCALL] = 'CC_FASTCALL'; -$CALLCONV[CC_CDECL] = 'CC_CDECL'; -$CALLCONV[CC_PASCAL] = 'CC_PASCAL'; -$CALLCONV[CC_MACPASCAL] = 'CC_MACPASCAL'; -$CALLCONV[CC_STDCALL] = 'CC_STDCALL'; -$CALLCONV[CC_FPFASTCALL] = 'CC_FPFASTCALL'; -$CALLCONV[CC_SYSCALL] = 'CC_SYSCALL'; -$CALLCONV[CC_MPWCDECL] = 'CC_MPWCDECL'; -$CALLCONV[CC_MPWPASCAL] = 'CC_MPWPASCAL'; - -# Function Kind -# ------------- - -sub FUNC_VIRTUAL () { 0; } -sub FUNC_PUREVIRTUAL () { FUNC_VIRTUAL() + 1; } -sub FUNC_NONVIRTUAL () { FUNC_PUREVIRTUAL() + 1; } -sub FUNC_STATIC () { FUNC_NONVIRTUAL() + 1; } -sub FUNC_DISPATCH () { FUNC_STATIC() + 1; } - -$FUNCKIND[FUNC_VIRTUAL] = 'FUNC_VIRTUAL'; -$FUNCKIND[FUNC_PUREVIRTUAL] = 'FUNC_PUREVIRTUAL'; -$FUNCKIND[FUNC_NONVIRTUAL] = 'FUNC_NONVIRTUAL'; -$FUNCKIND[FUNC_STATIC] = 'FUNC_STATIC'; -$FUNCKIND[FUNC_DISPATCH] = 'FUNC_DISPATCH'; - -# Invoke Kind -# ----------- - -sub INVOKE_FUNC () { 1; } -sub INVOKE_PROPERTYGET () { 2; } -sub INVOKE_PROPERTYPUT () { 4; } -sub INVOKE_PROPERTYPUTREF () { 8; } - -$INVOKEKIND{INVOKE_FUNC()} = INVOKE_FUNC; -$INVOKEKIND{INVOKE_PROPERTYGET()} = INVOKE_PROPERTYGET; -$INVOKEKIND{INVOKE_PROPERTYPUT()} = INVOKE_PROPERTYPUT; -$INVOKEKIND{INVOKE_PROPERTYPUTREF()} = INVOKE_PROPERTYPUTREF; - -# Variable Flags -# -------------- - -sub VARFLAG_FREADONLY () { 0x1; } -sub VARFLAG_FSOURCE () { 0x2; } -sub VARFLAG_FBINDABLE () { 0x4; } -sub VARFLAG_FREQUESTEDIT () { 0x8; } -sub VARFLAG_FDISPLAYBIND () { 0x10; } -sub VARFLAG_FDEFAULTBIND () { 0x20; } -sub VARFLAG_FHIDDEN () { 0x40; } -sub VARFLAG_FRESTRICTED () { 0x80; } -sub VARFLAG_FDEFAULTCOLLELEM () { 0x100; } -sub VARFLAG_FUIDEFAULT () { 0x200; } -sub VARFLAG_FNONBROWSABLE () { 0x400; } -sub VARFLAG_FREPLACEABLE () { 0x800; } -sub VARFLAG_FIMMEDIATEBIND () { 0x1000; } - -$VARFLAGS{VARFLAG_FREADONLY()} = VARFLAG_FREADONLY; -$VARFLAGS{VARFLAG_FSOURCE()} = VARFLAG_FSOURCE; -$VARFLAGS{VARFLAG_FBINDABLE()} = VARFLAG_FBINDABLE; -$VARFLAGS{VARFLAG_FREQUESTEDIT()} = VARFLAG_FREQUESTEDIT; -$VARFLAGS{VARFLAG_FDISPLAYBIND()} = VARFLAG_FDISPLAYBIND; -$VARFLAGS{VARFLAG_FDEFAULTBIND()} = VARFLAG_FDEFAULTBIND; -$VARFLAGS{VARFLAG_FHIDDEN()} = VARFLAG_FHIDDEN; -$VARFLAGS{VARFLAG_FRESTRICTED()} = VARFLAG_FRESTRICTED; -$VARFLAGS{VARFLAG_FDEFAULTCOLLELEM()} = VARFLAG_FDEFAULTCOLLELEM; -$VARFLAGS{VARFLAG_FUIDEFAULT()} = VARFLAG_FUIDEFAULT; -$VARFLAGS{VARFLAG_FNONBROWSABLE()} = VARFLAG_FNONBROWSABLE; -$VARFLAGS{VARFLAG_FREPLACEABLE()} = VARFLAG_FREPLACEABLE; -$VARFLAGS{VARFLAG_FIMMEDIATEBIND()} = VARFLAG_FIMMEDIATEBIND; - - -# Variant Types -# ------------- - -sub VT_EMPTY () { 0; } -sub VT_NULL () { 1; } -sub VT_I2 () { 2; } -sub VT_I4 () { 3; } -sub VT_R4 () { 4; } -sub VT_R8 () { 5; } -sub VT_CY () { 6; } -sub VT_DATE () { 7; } -sub VT_BSTR () { 8; } -sub VT_DISPATCH () { 9; } -sub VT_ERROR () { 10; } -sub VT_BOOL () { 11; } -sub VT_VARIANT () { 12; } -sub VT_UNKNOWN () { 13; } -sub VT_DECIMAL () { 14; } -sub VT_I1 () { 16; } -sub VT_UI1 () { 17; } -sub VT_UI2 () { 18; } -sub VT_UI4 () { 19; } -sub VT_I8 () { 20; } -sub VT_UI8 () { 21; } -sub VT_INT () { 22; } -sub VT_UINT () { 23; } -sub VT_VOID () { 24; } -sub VT_HRESULT () { 25; } -sub VT_PTR () { 26; } -sub VT_SAFEARRAY () { 27; } -sub VT_CARRAY () { 28; } -sub VT_USERDEFINED () { 29; } -sub VT_LPSTR () { 30; } -sub VT_LPWSTR () { 31; } -sub VT_FILETIME () { 64; } -sub VT_BLOB () { 65; } -sub VT_STREAM () { 66; } -sub VT_STORAGE () { 67; } -sub VT_STREAMED_OBJECT () { 68; } -sub VT_STORED_OBJECT () { 69; } -sub VT_BLOB_OBJECT () { 70; } -sub VT_CF () { 71; } -sub VT_CLSID () { 72; } -sub VT_VECTOR () { 0x1000; } -sub VT_ARRAY () { 0x2000; } -sub VT_BYREF () { 0x4000; } -sub VT_RESERVED () { 0x8000; } -sub VT_ILLEGAL () { 0xffff; } -sub VT_ILLEGALMASKED () { 0xfff; } -sub VT_TYPEMASK () { 0xfff; } - -$VT[VT_EMPTY] = 'VT_EMPTY'; -$VT[VT_NULL] = 'VT_NULL'; -$VT[VT_I2] = 'VT_I2'; -$VT[VT_I4] = 'VT_I4'; -$VT[VT_R4] = 'VT_R4'; -$VT[VT_R8] = 'VT_R8'; -$VT[VT_CY] = 'VT_CY'; -$VT[VT_DATE] = 'VT_DATE'; -$VT[VT_BSTR] = 'VT_BSTR'; -$VT[VT_DISPATCH] = 'VT_DISPATCH'; -$VT[VT_ERROR] = 'VT_ERROR'; -$VT[VT_BOOL] = 'VT_BOOL'; -$VT[VT_VARIANT] = 'VT_VARIANT'; -$VT[VT_UNKNOWN] = 'VT_UNKNOWN'; -$VT[VT_DECIMAL] = 'VT_DECIMAL'; -$VT[VT_I1] = 'VT_I1'; -$VT[VT_UI1] = 'VT_UI1'; -$VT[VT_UI2] = 'VT_UI2'; -$VT[VT_UI4] = 'VT_UI4'; -$VT[VT_I8] = 'VT_I8'; -$VT[VT_UI8] = 'VT_UI8'; -$VT[VT_INT] = 'VT_INT'; -$VT[VT_UINT] = 'VT_UINT'; -$VT[VT_VOID] = 'VT_VOID'; -$VT[VT_HRESULT] = 'VT_HRESULT'; -$VT[VT_PTR] = 'VT_PTR'; -$VT[VT_SAFEARRAY] = 'VT_SAFEARRAY'; -$VT[VT_CARRAY] = 'VT_CARRAY'; -$VT[VT_USERDEFINED] = 'VT_USERDEFINED'; -$VT[VT_LPSTR] = 'VT_LPSTR'; -$VT[VT_LPWSTR] = 'VT_LPWSTR'; -$VT[VT_FILETIME] = 'VT_FILETIME'; -$VT[VT_BLOB] = 'VT_BLOB'; -$VT[VT_STREAM] = 'VT_STREAM'; -$VT[VT_STORAGE] = 'VT_STORAGE'; -$VT[VT_STREAMED_OBJECT] = 'VT_STREAMED_OBJECT'; -$VT[VT_STORED_OBJECT] = 'VT_STORED_OBJECT'; -$VT[VT_BLOB_OBJECT] = 'VT_BLOB_OBJECT'; -$VT[VT_CF] = 'VT_CF'; -$VT[VT_CLSID] = 'VT_CLSID'; -$VT[VT_VECTOR] = 'VT_VECTOR'; -$VT[VT_ARRAY] = 'VT_ARRAY'; -$VT[VT_BYREF] = 'VT_BYREF'; -$VT[VT_RESERVED] = 'VT_RESERVED'; -$VT[VT_ILLEGAL] = 'VT_ILLEGAL'; -$VT[VT_ILLEGALMASKED] = 'VT_ILLEGALMASKED'; -$VT[VT_TYPEMASK] = 'VT_TYPEMASK'; - -1; diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/Variant.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE/Variant.pm deleted file mode 100755 index 38fc6048209..00000000000 --- a/Master/tlpkg/tlperl/site/lib/Win32/OLE/Variant.pm +++ /dev/null @@ -1,577 +0,0 @@ -# The documentation is at the __END__ - -package Win32::OLE::Variant; -require Win32::OLE; # Make sure the XS bootstrap has been called - -use strict; -use vars qw(@ISA @EXPORT @EXPORT_OK); - -use Exporter; -@ISA = qw(Exporter); - -@EXPORT = qw( - Variant - VT_EMPTY VT_NULL VT_I2 VT_I4 VT_R4 VT_R8 VT_CY VT_DATE VT_BSTR - VT_DISPATCH VT_ERROR VT_BOOL VT_VARIANT VT_UNKNOWN VT_DECIMAL VT_UI1 - VT_ARRAY VT_BYREF - ); - -@EXPORT_OK = qw(CP_ACP CP_OEMCP nothing nullstring); - -# Automation data types. -sub VT_EMPTY {0;} -sub VT_NULL {1;} -sub VT_I2 {2;} -sub VT_I4 {3;} -sub VT_R4 {4;} -sub VT_R8 {5;} -sub VT_CY {6;} -sub VT_DATE {7;} -sub VT_BSTR {8;} -sub VT_DISPATCH {9;} -sub VT_ERROR {10;} -sub VT_BOOL {11;} -sub VT_VARIANT {12;} -sub VT_UNKNOWN {13;} -sub VT_DECIMAL {14;} # Officially not allowed in VARIANTARGs -sub VT_UI1 {17;} - -sub VT_ARRAY {0x2000;} -sub VT_BYREF {0x4000;} - - -# For backward compatibility -sub CP_ACP {0;} # ANSI codepage -sub CP_OEMCP {1;} # OEM codepage - -use overload - # '+' => 'Add', '-' => 'Sub', '*' => 'Mul', '/' => 'Div', - '""' => sub {$_[0]->As(VT_BSTR)}, - '0+' => sub {$_[0]->As(VT_R8)}, - fallback => 1; - -sub Variant { - return Win32::OLE::Variant->new(@_); -} - -sub nothing { - return Win32::OLE::Variant->new(VT_DISPATCH); -} - -sub nullstring { - return Win32::OLE::Variant->new(VT_BSTR); -} - -1; - -__END__ - -=head1 NAME - -Win32::OLE::Variant - Create and modify OLE VARIANT variables - -=head1 SYNOPSIS - - use Win32::OLE::Variant; - my $var = Variant(VT_DATE, 'Jan 1,1970'); - $OleObject->{value} = $var; - $OleObject->Method($var); - - -=head1 DESCRIPTION - -The IDispatch interface used by the Perl OLE module uses a universal -argument type called VARIANT. This is basically an object containing -a data type and the actual data value. The data type is specified by -the VT_xxx constants. - -=head2 Functions - -=over 8 - -=item nothing() - -The nothing() function returns an empty VT_DISPATCH variant. It can be -used to clear an object reference stored in a property - - use Win32::OLE::Variant qw(:DEFAULT nothing); - # ... - $object->{Property} = nothing; - -This has the same effect as the Visual Basic statement - - Set object.Property = Nothing - -The nothing() function is B<not> exported by default. - -=item nullstring() - -The nullstring() function returns a VT_BSTR variant with a NULL string -pointer. This is B<not> the same as a VT_BSTR variant with an empty -string "". The nullstring() value is the same as the vbNullString -constant in Visual Basic. - -The nullstring() function is B<not> exported by default. - -=item Variant(TYPE, DATA) - -This is just a function alias of the C<Win32::OLE::Variant->new()> -method (see below). This function is exported by default. - -=back - -=head2 Methods - -=over 8 - -=item new(TYPE, DATA) - -This method returns a Win32::OLE::Variant object of the specified -TYPE that contains the given DATA. The Win32::OLE::Variant object -can be used to specify data types other than IV, NV or PV (which are -supported transparently). See L<Variants> below for details. - -For VT_EMPTY and VT_NULL variants, the DATA argument may be omitted. -For all non-VT_ARRAY variants DATA specifies the initial value. - -To create a SAFEARRAY variant, you have to specify the VT_ARRAY flag in -addition to the variant base type of the array elements. In this cases -DATA must be a list specifying the dimensions of the array. Each element -can be either an element count (indices 0 to count-1) or an array -reference pointing to the lower and upper array bounds of this dimension: - - my $Array = Win32::OLE::Variant->new(VT_ARRAY|VT_R8, [1,2], 2); - -This creates a 2-dimensional SAFEARRAY of doubles with 4 elements: -(1,0), (1,1), (2,0) and (2,1). - -A special case is the creation of one-dimensional VT_UI1 arrays with -a string DATA argument: - - my $String = Variant(VT_ARRAY|VT_UI1, "String"); - -This creates a 6 element character array initialized to "String". For -backward compatibility VT_UI1 with a string initializer automatically -implies VT_ARRAY. The next line is equivalent to the previous example: - - my $String = Variant(VT_UI1, "String"); - -If you really need a single character VT_UI1 variant, you have to create -it using a numeric intializer: - - my $Char = Variant(VT_UI1, ord('A')); - -=item As(TYPE) - -C<As> converts the VARIANT to the new type before converting to a -Perl value. This take the current LCID setting into account. For -example a string might contain a ',' as the decimal point character. -Using C<$variant->As(VT_R8)> will correctly return the floating -point value. - -The underlying variant object is NOT changed by this method. - -=item ChangeType(TYPE) - -This method changes the type of the contained VARIANT in place. It -returns the object itself, not the converted value. - -=item Copy([DIM]) - -This method creates a copy of the object. If the original variant had -the VT_BYREF bit set then the new object will contain a copy of the -referenced data and not a reference to the same old data. The new -object will not have the VT_BYREF bit set. - - my $Var = Variant(VT_I4|VT_ARRAY|VT_BYREF, [1,5], 3); - my $Copy = $Var->Copy; - -The type of C<$Copy> is now VT_I4|VT_ARRAY and the value is a copy of -the other SAFEARRAY. Changes to elements of C<$Var> will not be reflected -in C<$Copy> and vice versa. - -The C<Copy> method can also be used to extract a single element of a -VT_ARRAY | VT_VARIANT object. In this case the array indices must be -specified as a list DIM: - - my $Int = $Var->Copy(1, 2); - -C<$Int> is now a VT_I4 Variant object containing the value of element (1,2). - -=item Currency([FORMAT[, LCID]]) - -This method converts the VARIANT value into a formatted currency string. The -FORMAT can be either an integer constant or a hash reference. Valid constants -are 0 and LOCALE_NOUSEROVERRIDE. You get the value of LOCALE_NOUSEROVERRIDE -from the Win32::OLE::NLS module: - - use Win32::OLE::NLS qw(:LOCALE); - -LOCALE_NOUSEROVERRIDE tells the method to use the system default currency -format for the specified locale, disregarding any changes that might have -been made through the control panel application. - -The hash reference could contain the following keys: - - NumDigits number of fractional digits - LeadingZero whether to use leading zeroes in decimal fields - Grouping size of each group of digits to the left of the decimal - DecimalSep decimal separator string - ThousandSep thousand separator string - NegativeOrder see L<Win32::OLE::NLS/LOCALE_ICURRENCY> - PositiveOrder see L<Win32::OLE::NLS/LOCALE_INEGCURR> - CurrencySymbol currency symbol string - -For example: - - use Win32::OLE::Variant; - use Win32::OLE::NLS qw(:DEFAULT :LANG :SUBLANG :DATE :TIME); - my $lcidGerman = MAKELCID(MAKELANGID(LANG_GERMAN, SUBLANG_NEUTRAL)); - my $v = Variant(VT_CY, "-922337203685477.5808"); - print $v->Currency({CurrencySymbol => "Tuits"}, $lcidGerman), "\n"; - -will print: - - -922.337.203.685.477,58 Tuits - -=item Date([FORMAT[, LCID]]) - -Converts the VARIANT into a formatted date string. FORMAT can be either -one of the following integer constants or a format string: - - LOCALE_NOUSEROVERRIDE system default date format for this locale - DATE_SHORTDATE use the short date format (default) - DATE_LONGDATE use the long date format - DATE_YEARMONTH use the year/month format - DATE_USE_ALT_CALENDAR use the alternate calendar, if one exists - DATE_LTRREADING left-to-right reading order layout - DATE_RTLREADING right-to left reading order layout - -The constants are available from the Win32::OLE::NLS module: - - use Win32::OLE::NLS qw(:LOCALE :DATE); - -The following elements can be used to construct a date format string. -Characters must be specified exactly as given below (e.g. "dd" B<not> "DD"). -Spaces can be inserted anywhere between formatting codes, other verbatim -text should be included in single quotes. - - d day of month - dd day of month with leading zero for single-digit days - ddd day of week: three-letter abbreviation (LOCALE_SABBREVDAYNAME) - dddd day of week: full name (LOCALE_SDAYNAME) - M month - MM month with leading zero for single-digit months - MMM month: three-letter abbreviation (LOCALE_SABBREVMONTHNAME) - MMMM month: full name (LOCALE_SMONTHNAME) - y year as last two digits - yy year as last two digits with leading zero for years less than 10 - yyyy year represented by full four digits - gg period/era string - -For example: - - my $v = Variant(VT_DATE, "April 1 99"); - print $v->Date(DATE_LONGDATE), "\n"; - print $v->Date("ddd',' MMM dd yy"), "\n"; - -will print: - - Thursday, April 01, 1999 - Thu, Apr 01 99 - -=item Dim() - -Returns a list of array bounds for a VT_ARRAY variant. The list contains -an array reference for each dimension of the variant's SAFEARRAY. This -reference points to an array containing the lower and upper bounds for -this dimension. For example: - - my @Dim = $Var->Dim; - -Now C<@Dim> contains the following list: C<([1,5], [0,2])>. - -=item Get(DIM) - -For normal variants C<Get> returns the value of the variant, just like the -C<Value> method. For VT_ARRAY variants C<Get> retrieves the value of a single -array element. In this case C<DIM> must be a list of array indices. E.g. - - my $Val = $Var->Get(2,0); - -As a special case for one dimensional VT_UI1|VT_ARRAY variants the C<Get> -method without arguments returns the character array as a Perl string. - - print $String->Get, "\n"; - -=item IsNothing() - -Tests if the object is an empty VT_DISPATCH variant. See also nothing(). - -=item IsNullString() - -Tests if the object is an empty VT_BSTR variant. See also nullstring(). - -=item LastError() - -The use of the C<Win32::OLE::Variant->LastError()> method is deprecated. -Please use the C<Win32::OLE->LastError()> class method instead. - -=item Number([FORMAT[, LCID]]) - -This method converts the VARIANT value into a formatted number string. The -FORMAT can be either an integer constant or a hash reference. Valid constants -are 0 and LOCALE_NOUSEROVERRIDE. You get the value of LOCALE_NOUSEROVERRIDE -from the Win32::OLE::NLS module: - - use Win32::OLE::NLS qw(:LOCALE); - -LOCALE_NOUSEROVERRIDE tells the method to use the system default number -format for the specified locale, disregarding any changes that might have -been made through the control panel application. - -The hash reference could contain the following keys: - - NumDigits number of fractional digits - LeadingZero whether to use leading zeroes in decimal fields - Grouping size of each group of digits to the left of the decimal - DecimalSep decimal separator string - ThousandSep thousand separator string - NegativeOrder see L<Win32::OLE::NLS/LOCALE_INEGNUMBER> - -=item Put(DIM, VALUE) - -The C<Put> method is used to assign a new value to a variant. The value will -be coerced into the current type of the variant. E.g.: - - my $Var = Variant(VT_I4, 42); - $Var->Put(3.1415); - -This changes the value of the variant to C<3> because the type is VT_I4. - -For VT_ARRAY type variants the indices for each dimension of the contained -SAFEARRAY must be specified in front of the new value: - - $Array->Put(1, 1, 2.7); - -It is also possible to assign values to *every* element of the SAFEARRAY at -once using a single Put() method call: - - $Array->Put([[1,2], [3,4]]); - -In this case the argument to Put() must be an array reference and the -dimensions of the Perl list-of-lists must match the dimensions of the -SAFEARRAY exactly. - -The are a few special cases for one-dimensional VT_UI1 arrays: The VALUE -can be specified as a string instead of a number. This will set the selected -character to the first character of the string or to '\0' if the string was -empty: - - my $String = Variant(VT_UI1|VT_ARRAY, "ABCDE"); - $String->Put(1, "123"); - $String->Put(3, ord('Z')); - $String->Put(4, ''); - -This will set the value of C<$String> to C<"A1CZ\0">. If the index is omitted -then the string is copied to the value completely. The string is truncated -if it is longer than the size of the VT_UI1 array. The result will be padded -with '\0's if the string is shorter: - - $String->Put("String"); - -Now C<$String> contains the value "Strin". - -C<Put> returns the Variant object itself so that multiple C<Put> calls can be -chained together: - - $Array->Put(0,0,$First_value)->Put(0,1,$Another_value); - -=item Time([FORMAT[, LCID]]) - -Converts the VARIANT into a formatted time string. FORMAT can be either -one of the following integer constants or a format string: - - LOCALE_NOUSEROVERRIDE system default time format for this locale - TIME_NOMINUTESORSECONDS don't use minutes or seconds - TIME_NOSECONDS don't use seconds - TIME_NOTIMEMARKER don't use a time marker - TIME_FORCE24HOURFORMAT always use a 24-hour time format - -The constants are available from the Win32::OLE::NLS module: - - use Win32::OLE::NLS qw(:LOCALE :TIME); - -The following elements can be used to construct a time format string. -Characters must be specified exactly as given below (e.g. "dd" B<not> "DD"). -Spaces can be inserted anywhere between formatting codes, other verbatim -text should be included in single quotes. - - h hours; 12-hour clock - hh hours with leading zero for single-digit hours; 12-hour clock - H hours; 24-hour clock - HH hours with leading zero for single-digit hours; 24-hour clock - m minutes - mm minutes with leading zero for single-digit minutes - s seconds - ss seconds with leading zero for single-digit seconds - t one character time marker string, such as A or P - tt multicharacter time marker string, such as AM or PM - -For example: - - my $v = Variant(VT_DATE, "April 1 99 2:23 pm"); - print $v->Time, "\n"; - print $v->Time(TIME_FORCE24HOURFORMAT|TIME_NOTIMEMARKER), "\n"; - print $v->Time("hh.mm.ss tt"), "\n"; - -will print: - - 2:23:00 PM - 14:23:00 - 02.23.00 PM - -=item Type() - -The C<Type> method returns the variant type of the contained VARIANT. - -=item Unicode() - -The C<Unicode> method returns a C<Unicode::String> object. This contains -the BSTR value of the variant in network byte order. If the variant is -not currently in VT_BSTR format then a VT_BSTR copy will be produced first. - -=item Value() - -The C<Value> method returns the value of the VARIANT as a Perl value. The -conversion is performed in the same manner as all return values of -Win32::OLE method calls are converted. - -=back - -=head2 Overloading - -The Win32::OLE::Variant package has overloaded the conversion to -string and number formats. Therefore variant objects can be used in -arithmetic and string operations without applying the C<Value> -method first. - -=head2 Class Variables - -The Win32::OLE::Variant class used to have its own set of class variables -like C<$CP>, C<$LCID> and C<$Warn>. In version 0.1003 and later of the -Win32::OLE module these variables have been eliminated. Now the settings -of Win32::OLE are used by the Win32::OLE::Variant module too. Please read -the documentation of the C<Win32::OLE->Option> class method. - - -=head2 Constants - -These constants are exported by default: - - VT_EMPTY - VT_NULL - VT_I2 - VT_I4 - VT_R4 - VT_R8 - VT_CY - VT_DATE - VT_BSTR - VT_DISPATCH - VT_ERROR - VT_BOOL - VT_VARIANT - VT_UNKNOWN - VT_DECIMAL - VT_UI1 - - VT_ARRAY - VT_BYREF - -VT_DECIMAL is not on the official list of allowable OLE Automation -datatypes. But even Microsoft ADO seems to sometimes return values -of Recordset fields in VT_DECIMAL format. - -=head2 Variants - -A Variant is a data type that is used to pass data between OLE -connections. - -The default behavior is to convert each perl scalar variable into -an OLE Variant according to the internal perl representation. -The following type correspondence holds: - - C type Perl type OLE type - ------ --------- -------- - int IV VT_I4 - double NV VT_R8 - char * PV VT_BSTR - void * ref to AV VT_ARRAY - ? undef VT_ERROR - ? Win32::OLE object VT_DISPATCH - -Note that VT_BSTR is a wide character or Unicode string. This presents a -problem if you want to pass in binary data as a parameter as 0x00 is -inserted between all the bytes in your data. The C<Variant()> method -provides a solution to this. With Variants the script writer can specify -the OLE variant type that the parameter should be converted to. Currently -supported types are: - - VT_UI1 unsigned char - VT_I2 signed int (2 bytes) - VT_I4 signed int (4 bytes) - VT_R4 float (4 bytes) - VT_R8 float (8 bytes) - VT_DATE OLE Date - VT_BSTR OLE String - VT_CY OLE Currency - VT_BOOL OLE Boolean - -When VT_DATE and VT_CY objects are created, the input parameter is treated -as a Perl string type, which is then converted to VT_BSTR, and finally to -VT_DATE of VT_CY using the C<VariantChangeType()> OLE API function. -See L<Win32::OLE/EXAMPLES> for how these types can be used. - -=head2 Variant arrays - -A variant can not only contain a single value but also a multi-dimensional -array of values (called a SAFEARRAY). In this case the VT_ARRAY flag must -be added to the base variant type, e.g. C<VT_I4 | VT_ARRAY> for an array of -integers. The VT_EMPTY and VT_NULL types are invalid for SAFEARRAYs. It -is possible to create an array of variants: C<VT_VARIANT | VT_ARRAY>. In this -case each element of the array can have a different type (including VT_EMPTY -and VT_NULL). The elements of a VT_VARIANT SAFEARRAY cannot have either of the -VT_ARRAY or VT_BYREF flags set. - -The lower and upper bounds for each dimension can be specified separately. -They do not have to have all the same lower bound (unlike Perl's arrays). - -=head2 Variants by reference - -Some OLE servers expect parameters passed by reference so that they -can be changed in the method call. This allows methods to easily -return multiple values. There is preliminary support for this in -the Win32::OLE::Variant module: - - my $x = Variant(VT_I4|VT_BYREF, 0); - my $y = Variant(VT_I4|VT_BYREF, 0); - $Corel->GetSize($x, $y); - print "Size is $x by $y\n"; - -After the C<GetSize> method call C<$x> and C<$y> will be set to -the respective sizes. They will still be variants. In the print -statement the overloading converts them to string representation -automatically. - -VT_BYREF is now supported for all variant types (including SAFEARRAYs). -It can also be used to pass an OLE object by reference: - - my $Results = $App->CreateResultsObject; - $Object->Method(Variant(VT_DISPATCH|VT_BYREF, $Results)); - -=head1 AUTHORS/COPYRIGHT - -This module is part of the Win32::OLE distribution. - -=cut diff --git a/Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/.packlist b/Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/.packlist deleted file mode 100755 index 4799e901a6c..00000000000 --- a/Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/.packlist +++ /dev/null @@ -1,11 +0,0 @@ -D:\tlperl\site\lib\OLE.pm
-D:\tlperl\site\lib\Win32\OLE.pm
-D:\tlperl\site\lib\Win32\OLE\Const.pm
-D:\tlperl\site\lib\Win32\OLE\Enum.pm
-D:\tlperl\site\lib\Win32\OLE\Lite.pm
-D:\tlperl\site\lib\Win32\OLE\NEWS.pod
-D:\tlperl\site\lib\Win32\OLE\NLS.pm
-D:\tlperl\site\lib\Win32\OLE\TPJ.pod
-D:\tlperl\site\lib\Win32\OLE\TypeInfo.pm
-D:\tlperl\site\lib\Win32\OLE\Variant.pm
-D:\tlperl\site\lib\auto\Win32\OLE\OLE.dll
diff --git a/Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/OLE.dll b/Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/OLE.dll Binary files differdeleted file mode 100755 index 8ef92c143ed..00000000000 --- a/Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/OLE.dll +++ /dev/null |