diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Win32/API/Callback.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Win32/API/Callback.pm | 91 |
1 files changed, 47 insertions, 44 deletions
diff --git a/Master/tlpkg/tlperl/lib/Win32/API/Callback.pm b/Master/tlpkg/tlperl/lib/Win32/API/Callback.pm index df15786591b..46879b4041b 100644 --- a/Master/tlpkg/tlperl/lib/Win32/API/Callback.pm +++ b/Master/tlpkg/tlperl/lib/Win32/API/Callback.pm @@ -4,28 +4,27 @@ ####################################################################### # # Win32::API::Callback - Perl Win32 API Import Facility -# +# # Author: Aldo Calpini <dada@perl.it> # Maintainer: Cosimo Streppone <cosimo@cpan.org> # -# $Id: Callback.pm 458 2009-01-17 17:27:43Z cosimo.streppone $ -# ####################################################################### package Win32::API::Callback; -$VERSION = '0.59'; +$VERSION = '0.68'; -require Exporter; # to export the constants to the main:: space -require DynaLoader; # to dynuhlode the module. +require Exporter; # to export the constants to the main:: space +require DynaLoader; # to dynuhlode the module. @ISA = qw( Exporter DynaLoader ); -sub DEBUG { - if ($WIN32::API::DEBUG) { - printf @_ if @_ or return 1; - } else { - return 0; - } +sub DEBUG { + if ($WIN32::API::DEBUG) { + printf @_ if @_ or return 1; + } + else { + return 0; + } } use Win32::API; @@ -39,18 +38,21 @@ use Win32::API::Struct; # sub AUTOLOAD { - my($constname); + my ($constname); ($constname = $AUTOLOAD) =~ s/.*:://; + #reset $! to zero to reset any current errors. - $!=0; + $! = 0; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/) { $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD; - } else { - ($pack,$file,$line) = caller; - die "Your vendor has not defined Win32::API::Callback macro $constname, used at $file line $line."; + } + else { + ($pack, $file, $line) = caller; + die + "Your vendor has not defined Win32::API::Callback macro $constname, used at $file line $line."; } } eval "sub $AUTOLOAD { $val }"; @@ -67,37 +69,38 @@ bootstrap Win32::API::Callback; # PUBLIC METHODS # sub new { - my($class, $proc, $in, $out) = @_; + my ($class, $proc, $in, $out) = @_; my %self = (); - # printf "(PM)Callback::new: got proc='%s', in='%s', out='%s'\n", $proc, $in, $out; - - $self{in} = []; - if(ref($in) eq 'ARRAY') { - foreach (@$in) { - push(@{ $self{in} }, Win32::API::type_to_num($_)); - } - } else { - my @in = split '', $in; - foreach (@in) { - push(@{ $self{in} }, Win32::API::type_to_num($_)); - } - } - $self{out} = Win32::API::type_to_num($out); - $self{sub} = $proc; - my $self = bless \%self, $class; - - DEBUG "(PM)Callback::new: calling CallbackCreate($self)...\n"; + # printf "(PM)Callback::new: got proc='%s', in='%s', out='%s'\n", $proc, $in, $out; + + $self{in} = []; + if (ref($in) eq 'ARRAY') { + foreach (@$in) { + push(@{$self{in}}, Win32::API::type_to_num($_)); + } + } + else { + my @in = split '', $in; + foreach (@in) { + push(@{$self{in}}, Win32::API::type_to_num($_)); + } + } + $self{out} = Win32::API::type_to_num($out); + $self{sub} = $proc; + my $self = bless \%self, $class; + + DEBUG "(PM)Callback::new: calling CallbackCreate($self)...\n"; my $hproc = CallbackCreate($self); - DEBUG "(PM)Callback::new: hproc=$hproc\n"; + DEBUG "(PM)Callback::new: hproc=$hproc\n"; #### ...if that fails, set $! accordingly - if(!$hproc) { + if (!$hproc) { $! = Win32::GetLastError(); return undef; } - + #### ok, let's stuff the object $self->{code} = $hproc; $self->{sub} = $proc; @@ -107,11 +110,11 @@ sub new { } sub MakeStruct { - my($self, $n, $addr) = @_; - DEBUG "(PM)Win32::API::Callback::MakeStruct: got self='$self'\n"; - my $struct = Win32::API::Struct->new($self->{intypes}->[$n]); - $struct->FromMemory($addr); - return $struct; + my ($self, $n, $addr) = @_; + DEBUG "(PM)Win32::API::Callback::MakeStruct: got self='$self'\n"; + my $struct = Win32::API::Struct->new($self->{intypes}->[$n]); + $struct->FromMemory($addr); + return $struct; } 1; |