PageRenderTime 50ms CodeModel.GetById 32ms app.highlight 14ms RepoModel.GetById 1ms app.codeStats 0ms

/IronPython_Main/Runtime/Tests/LinqDlrTests/testenv/perl/site/lib/OLE.pm

#
Perl | 177 lines | 116 code | 33 blank | 28 comment | 3 complexity | 89633eb08c828fdc2fe2974ec292fabc MD5 | raw file
  1# Compatibility layer for applications using the old toplevel OLE.pm.
  2# New code should use Win32::OLE
  3
  4# This file is based on ../lib/OLE.pm from ActiveState build 315.
  5
  6# Compatibility notes:
  7# - "GetObject" -> "GetActiveObject"
  8# - "keys %$collection" -> "Win32::OLE::Enum->All($collection)"
  9#                       or "in $Collection"
 10# - "unnamed" default method retries
 11
 12########################################################################
 13package Win32;
 14########################################################################
 15
 16sub OLELastError {return OLE->LastError()}
 17
 18
 19########################################################################
 20package OLE::Variant;
 21########################################################################
 22
 23use Win32::OLE qw(CP_ACP);
 24use Win32::OLE::Variant;
 25
 26use strict;
 27use vars qw($AUTOLOAD @ISA $LCID $CP $Warn $LastError $_NewEnum $_Unique);
 28@ISA = qw(Win32::OLE::Variant);
 29
 30$Warn = 0;
 31$LCID = 2 << 10; # LOCALE_SYSTEM_DEFAULT
 32$CP = CP_ACP;
 33$_NewEnum = 0;
 34$_Unique = 0;
 35
 36sub new {
 37    my $self = shift;
 38    my $variant = $self->SUPER::new(@_);
 39    $OLE::LastError = $Win32::OLE->LastError unless defined $variant;
 40    return $variant;
 41}
 42
 43
 44########################################################################
 45package OLE::Tie;
 46########################################################################
 47use strict;
 48use vars qw(@ISA);
 49@ISA = qw(Win32::OLE::Tie);
 50
 51# !!! It is VERY important that Win32::OLE::Tie::DESTROY gets called. !!!
 52# If you subclass DESTROY, don't forget to call $self->SUPER::DESTROY.
 53# Otherwise the OLE interfaces will not be released until process termination!
 54
 55# Retry default method if property doesn't exist
 56sub FETCH {
 57    my ($self,$key) = @_;
 58    return $self->SUPER::Fetch($key, 1);
 59}
 60
 61sub STORE {
 62    my ($self,$key,$value) = @_;
 63    $self->SUPER::Store($key, $value, 1);
 64}
 65
 66# Enumerate collection members, not object properties
 67*FIRSTKEY = *Win32::OLE::Tie::FIRSTENUM;
 68*NEXTKEY = *Win32::OLE::Tie::NEXTENUM;
 69
 70
 71########################################################################
 72package OLE;
 73########################################################################
 74use Win32::OLE qw(CP_ACP);
 75
 76# Use OleInitialize() instead of CoInitializeEx:
 77Win32::OLE->Initialize(Win32::OLE::COINIT_OLEINITIALIZE);
 78
 79use strict;
 80
 81# Disable overload; unfortunately "no overload" doesn't do it :-(
 82# Overloading is no longer enabled by default in Win32::OLE
 83#use overload '""'     => sub {overload::StrVal($_[0])},
 84#             '0+'     => sub {overload::StrVal($_[0])};
 85
 86use vars qw($AUTOLOAD @ISA $LCID $CP $Warn $LastError $Tie);
 87@ISA = qw(Win32::OLE);
 88
 89$Warn = 0;
 90$LCID = 2 << 10; # LOCALE_SYSTEM_DEFAULT
 91$CP = CP_ACP;
 92$Tie = 'OLE::Tie';
 93
 94sub new {
 95    my $class = shift;
 96    $class = shift if $class eq 'OLE';
 97    return OLE->SUPER::new($class);
 98}
 99
100sub copy {
101    my $class = shift;
102    $class = shift if $class eq 'OLE';
103    return OLE->SUPER::GetActiveObject($class);
104}
105
106sub AUTOLOAD {
107    my $self = shift;
108    my $retval;
109    $AUTOLOAD =~ s/.*:://o;
110
111    Carp::croak("Cannot autoload class method \"$AUTOLOAD\"") 
112      unless ref($self) && UNIVERSAL::isa($self,'OLE');
113
114    local $^H = 0; # !hack alert!
115    unless (defined $self->Dispatch($AUTOLOAD, $retval, @_)) {
116	# Retry default method
117	$self->Dispatch(undef, $retval, $AUTOLOAD, @_);
118    }
119    return $retval;
120}
121
122*CreateObject = \&new;
123*GetObject = \&copy;
124
125# Automation data types.
126
127sub VT_EMPTY {0;}
128sub VT_NULL {1;}
129sub VT_I2 {2;}
130sub VT_I4 {3;}
131sub VT_R4 {4;}
132sub VT_R8 {5;}
133sub VT_CY {6;}
134sub VT_DATE {7;}
135sub VT_BSTR {8;}
136sub VT_DISPATCH {9;}
137sub VT_ERROR {10;}
138sub VT_BOOL {11;}
139sub VT_VARIANT {12;}
140sub VT_UNKNOWN {13;}
141sub VT_I1 {16;}
142sub VT_UI1 {17;}
143sub VT_UI2 {18;}
144sub VT_UI4 {19;}
145sub VT_I8 {20;}
146sub VT_UI8 {21;}
147sub VT_INT {22;}
148sub VT_UINT {23;}
149sub VT_VOID {24;}
150sub VT_HRESULT {25;}
151sub VT_PTR {26;}
152sub VT_SAFEARRAY {27;}
153sub VT_CARRAY {28;}
154sub VT_USERDEFINED {29;}
155sub VT_LPSTR {30;}
156sub VT_LPWSTR {31;}
157sub VT_FILETIME {64;}
158sub VT_BLOB {65;}
159sub VT_STREAM {66;}
160sub VT_STORAGE {67;}
161sub VT_STREAMED_OBJECT {68;}
162sub VT_STORED_OBJECT {69;}
163sub VT_BLOB_OBJECT {70;}
164sub VT_CF {71;}
165sub VT_CLSID {72;}
166
167sub TKIND_ENUM {0;}
168sub TKIND_RECORD {1;}
169sub TKIND_MODULE {2;}
170sub TKIND_INTERFACE {3;}
171sub TKIND_DISPATCH {4;}
172sub TKIND_COCLASS {5;}
173sub TKIND_ALIAS {6;}
174sub TKIND_UNION {7;}
175sub TKIND_MAX {8;}
176
1771;