diff options
Diffstat (limited to 'Master/tlpkg/tlperl/site/lib/OLE.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/OLE.pm | 177 |
1 files changed, 0 insertions, 177 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; |