Skip to content

Commit ebbafaf

Browse files
committed
General perltidy applied to everything
1 parent 8ba7176 commit ebbafaf

34 files changed

+1475
-1418
lines changed

API.pm

+147-117
Large diffs are not rendered by default.

Callback.pm

+47-42
Original file line numberDiff line numberDiff line change
@@ -4,26 +4,27 @@
44
#######################################################################
55
#
66
# Win32::API::Callback - Perl Win32 API Import Facility
7-
#
7+
#
88
# Author: Aldo Calpini <[email protected]>
99
# Maintainer: Cosimo Streppone <[email protected]>
1010
#
1111
#######################################################################
1212

1313
package Win32::API::Callback;
1414

15-
$VERSION = '0.64';
15+
$VERSION = '0.65';
1616

17-
require Exporter; # to export the constants to the main:: space
18-
require DynaLoader; # to dynuhlode the module.
17+
require Exporter; # to export the constants to the main:: space
18+
require DynaLoader; # to dynuhlode the module.
1919
@ISA = qw( Exporter DynaLoader );
2020

21-
sub DEBUG {
22-
if ($WIN32::API::DEBUG) {
23-
printf @_ if @_ or return 1;
24-
} else {
25-
return 0;
26-
}
21+
sub DEBUG {
22+
if ($WIN32::API::DEBUG) {
23+
printf @_ if @_ or return 1;
24+
}
25+
else {
26+
return 0;
27+
}
2728
}
2829

2930
use Win32::API;
@@ -37,18 +38,21 @@ use Win32::API::Struct;
3738
#
3839

3940
sub AUTOLOAD {
40-
my($constname);
41+
my ($constname);
4142
($constname = $AUTOLOAD) =~ s/.*:://;
43+
4244
#reset $! to zero to reset any current errors.
43-
$!=0;
45+
$! = 0;
4446
my $val = constant($constname, @_ ? $_[0] : 0);
4547
if ($! != 0) {
4648
if ($! =~ /Invalid/) {
4749
$AutoLoader::AUTOLOAD = $AUTOLOAD;
4850
goto &AutoLoader::AUTOLOAD;
49-
} else {
50-
($pack,$file,$line) = caller;
51-
die "Your vendor has not defined Win32::API::Callback macro $constname, used at $file line $line.";
51+
}
52+
else {
53+
($pack, $file, $line) = caller;
54+
die
55+
"Your vendor has not defined Win32::API::Callback macro $constname, used at $file line $line.";
5256
}
5357
}
5458
eval "sub $AUTOLOAD { $val }";
@@ -65,37 +69,38 @@ bootstrap Win32::API::Callback;
6569
# PUBLIC METHODS
6670
#
6771
sub new {
68-
my($class, $proc, $in, $out) = @_;
72+
my ($class, $proc, $in, $out) = @_;
6973
my %self = ();
7074

71-
# printf "(PM)Callback::new: got proc='%s', in='%s', out='%s'\n", $proc, $in, $out;
72-
73-
$self{in} = [];
74-
if(ref($in) eq 'ARRAY') {
75-
foreach (@$in) {
76-
push(@{ $self{in} }, Win32::API::type_to_num($_));
77-
}
78-
} else {
79-
my @in = split '', $in;
80-
foreach (@in) {
81-
push(@{ $self{in} }, Win32::API::type_to_num($_));
82-
}
83-
}
84-
$self{out} = Win32::API::type_to_num($out);
85-
$self{sub} = $proc;
86-
my $self = bless \%self, $class;
87-
88-
DEBUG "(PM)Callback::new: calling CallbackCreate($self)...\n";
75+
# printf "(PM)Callback::new: got proc='%s', in='%s', out='%s'\n", $proc, $in, $out;
76+
77+
$self{in} = [];
78+
if (ref($in) eq 'ARRAY') {
79+
foreach (@$in) {
80+
push(@{$self{in}}, Win32::API::type_to_num($_));
81+
}
82+
}
83+
else {
84+
my @in = split '', $in;
85+
foreach (@in) {
86+
push(@{$self{in}}, Win32::API::type_to_num($_));
87+
}
88+
}
89+
$self{out} = Win32::API::type_to_num($out);
90+
$self{sub} = $proc;
91+
my $self = bless \%self, $class;
92+
93+
DEBUG "(PM)Callback::new: calling CallbackCreate($self)...\n";
8994
my $hproc = CallbackCreate($self);
9095

91-
DEBUG "(PM)Callback::new: hproc=$hproc\n";
96+
DEBUG "(PM)Callback::new: hproc=$hproc\n";
9297

9398
#### ...if that fails, set $! accordingly
94-
if(!$hproc) {
99+
if (!$hproc) {
95100
$! = Win32::GetLastError();
96101
return undef;
97102
}
98-
103+
99104
#### ok, let's stuff the object
100105
$self->{code} = $hproc;
101106
$self->{sub} = $proc;
@@ -105,11 +110,11 @@ sub new {
105110
}
106111

107112
sub MakeStruct {
108-
my($self, $n, $addr) = @_;
109-
DEBUG "(PM)Win32::API::Callback::MakeStruct: got self='$self'\n";
110-
my $struct = Win32::API::Struct->new($self->{intypes}->[$n]);
111-
$struct->FromMemory($addr);
112-
return $struct;
113+
my ($self, $n, $addr) = @_;
114+
DEBUG "(PM)Win32::API::Callback::MakeStruct: got self='$self'\n";
115+
my $struct = Win32::API::Struct->new($self->{intypes}->[$n]);
116+
$struct->FromMemory($addr);
117+
return $struct;
113118
}
114119

115120
1;

Callback/t/02_Callback.t

+25-23
Original file line numberDiff line numberDiff line change
@@ -7,12 +7,13 @@
77

88
use strict;
99
use Config;
10-
use Test::More; plan tests => 8;
11-
use vars qw(
12-
$function
13-
$result
14-
$callback
15-
$test_dll
10+
use Test::More;
11+
plan tests => 8;
12+
use vars qw(
13+
$function
14+
$result
15+
$callback
16+
$test_dll
1617
);
1718

1819
use_ok('Win32::API');
@@ -28,35 +29,36 @@ my $cc_name = Win32::API::Test::compiler_name();
2829
my $cc_vers = Win32::API::Test::compiler_version();
2930
my $callback;
3031

31-
diag('Compiler name:', $cc_name);
32+
diag('Compiler name:', $cc_name);
3233
diag('Compiler version:', $cc_vers);
3334

3435
SKIP: {
3536

36-
skip('because bombs on gcc', 2) if $cc_name =~ /g?cc/;
37+
skip('because bombs on gcc', 2) if $cc_name =~ /g?cc/;
3738

38-
$callback = Win32::API::Callback->new(
39-
sub {
40-
my($value) = @_;
41-
return $value*2;
42-
},
43-
'N', 'N'
44-
);
45-
ok($callback, 'callback function defined');
39+
$callback = Win32::API::Callback->new(
40+
sub {
41+
my ($value) = @_;
42+
return $value * 2;
43+
},
44+
'N',
45+
'N'
46+
);
47+
ok($callback, 'callback function defined');
4648

47-
$function = new Win32::API($test_dll, 'do_callback', 'KI', 'I');
48-
ok(defined($function), 'defined function do_callback()');
49-
diag('$^E=', $^E);
49+
$function = new Win32::API($test_dll, 'do_callback', 'KI', 'I');
50+
ok(defined($function), 'defined function do_callback()');
51+
diag('$^E=', $^E);
5052

5153
}
5254

5355
SKIP: {
5456

55-
skip('because callbacks currently /SEGFAULT/ all compilers but MSVC 6+', 1)
56-
unless $cc_name eq 'cl' && $cc_vers >= 12;
57+
skip('because callbacks currently /SEGFAULT/ all compilers but MSVC 6+', 1)
58+
unless $cc_name eq 'cl' && $cc_vers >= 12;
5759

58-
$result = $function->Call( $callback, 21 );
59-
is($result, 42, 'callback function works');
60+
$result = $function->Call($callback, 21);
61+
is($result, 42, 'callback function works');
6062
}
6163

6264
#

Callback/t/03_Jim_Shaw.t

+25-22
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@
55
#
66
# Given a process ID and optionally a window class,
77
# return the windows matching the request with classnames.
8-
# Then we can monitor for unwanted dialogs in crusty
8+
# Then we can monitor for unwanted dialogs in crusty
99
# applications that we automated the starting of with
1010
# CreateProcess() and stored the PID. Also we can use OLE
1111
# to monitor for evil text in places where the original
@@ -14,10 +14,10 @@
1414
# However, due to some issues on Windows 2003 with Callback
1515
# (which is probably environmental - no issues on XP),
1616
# I've opted to use a non-callback funtion to achive the
17-
# same result: GetWindow(xx,GW_HWNDNEXT) and
17+
# same result: GetWindow(xx,GW_HWNDNEXT) and
1818
# GetWindow(xx,GW_CHILD)
1919
#
20-
# The problem I had was running this code on Windows
20+
# The problem I had was running this code on Windows
2121
# 2003 SP2 machines. It was throwing access violation
2222
# DrWatsons when the Perl was based anywhere except
2323
# C:\Perl. I was aiming for D:\sausage\perl.
@@ -37,11 +37,14 @@
3737
use strict;
3838
use warnings;
3939

40-
use Test::More; plan skip_all => 'Unclear why it fails';
40+
use Test::More;
41+
plan skip_all => 'Unclear why it fails';
42+
4143
#plan tests => 8;
4244

4345
use Win32::API;
4446
use Win32::API::Callback;
47+
4548
#$Win32::API::DEBUG=1;
4649

4750
use Data::Dumper;
@@ -52,12 +55,12 @@ use_ok('Win32::API::Test');
5255

5356
ok(1, 'loaded');
5457

55-
Win32::API->Import("user32", "GetWindowThreadProcessId", "NP", "N");
56-
Win32::API->Import("user32", "GetClassName", "NPI", "I");
57-
Win32::API->Import("user32", "GetWindowTextLength", "N", "I");
58-
Win32::API->Import("user32", "GetWindowText", "NPI", "I");
59-
Win32::API->Import("user32", "GetDesktopWindow", "", "N");
60-
Win32::API->Import("user32", "EnumChildWindows", "NKP", "I");
58+
Win32::API->Import("user32", "GetWindowThreadProcessId", "NP", "N");
59+
Win32::API->Import("user32", "GetClassName", "NPI", "I");
60+
Win32::API->Import("user32", "GetWindowTextLength", "N", "I");
61+
Win32::API->Import("user32", "GetWindowText", "NPI", "I");
62+
Win32::API->Import("user32", "GetDesktopWindow", "", "N");
63+
Win32::API->Import("user32", "EnumChildWindows", "NKP", "I");
6164

6265
my %_window_pids;
6366
my $max_str = 1024;
@@ -69,34 +72,34 @@ my $window_enumerator = sub {
6972
my $pid_raw_value = "\x0" x Win32::API::Type->sizeof("LPDWORD");
7073
GetWindowThreadProcessId($hwnd, $pid_raw_value);
7174

72-
my $window_pid = Win32::API::Type::Unpack("LPDWORD",$pid_raw_value);
75+
my $window_pid = Win32::API::Type::Unpack("LPDWORD", $pid_raw_value);
7376
print "window_enumerator - hwnd=[$hwnd], PID=[$window_pid]\n";
7477

7578
if ($window_pid) {
76-
my $class_size=Win32::API::Type->sizeof("CHAR*")*$max_str;
77-
my $window_class="\x0" x $class_size;
79+
my $class_size = Win32::API::Type->sizeof("CHAR*") * $max_str;
80+
my $window_class = "\x0" x $class_size;
7881
GetClassName($hwnd, $window_class, $class_size);
7982

80-
$window_class=~s/\0//g;
81-
$_window_pids{$window_pid}{$hwnd}{window_class}=$window_class;
82-
my $text_size=GetWindowTextLength($hwnd);
83-
if (Win32::API::IsUnicode()) {
84-
$text_size=$text_size*2;
83+
$window_class =~ s/\0//g;
84+
$_window_pids{$window_pid}{$hwnd}{window_class} = $window_class;
85+
my $text_size = GetWindowTextLength($hwnd);
86+
if (Win32::API::IsUnicode()) {
87+
$text_size = $text_size * 2;
8588
}
8689

8790
$text_size++;
88-
my $window_text="\x0" x $text_size;
91+
my $window_text = "\x0" x $text_size;
8992
GetWindowText($hwnd, $window_text, $text_size);
9093

91-
$window_text=~s/\0//g;
92-
$_window_pids{$window_pid}{$hwnd}{window_text}=$window_text;
94+
$window_text =~ s/\0//g;
95+
$_window_pids{$window_pid}{$hwnd}{window_text} = $window_text;
9396
}
9497

9598
return 1;
9699

97100
};
98101

99-
my $callback_routine = Win32::API::Callback->new($window_enumerator,"NN","I");
102+
my $callback_routine = Win32::API::Callback->new($window_enumerator, "NN", "I");
100103

101104
sub get_window_pids {
102105
my ($callback) = @_;

Callback/t/04_rt_53914.t

+9-8
Original file line numberDiff line numberDiff line change
@@ -18,14 +18,14 @@ plan tests => 2;
1818

1919
use_ok('Win32::API::Callback');
2020

21-
Win32::API->Import('kernel32', 'SetConsoleCtrlHandler', 'KL', 'L');
21+
Win32::API->Import('kernel32', 'SetConsoleCtrlHandler', 'KL', 'L');
2222
Win32::API->Import('kernel32', 'GenerateConsoleCtrlEvent', 'LL', 'L');
23-
Win32::API->Import('kernel32', 'GetLastError', '', 'L');
23+
Win32::API->Import('kernel32', 'GetLastError', '', 'L');
2424

2525
sub cb {
2626
my ($dwCtrlType) = @_;
2727

28-
open (FILE, '>', 'QUIT.TXT');
28+
open(FILE, '>', 'QUIT.TXT');
2929
print FILE "RECEIVED SIGNAL: $dwCtrlType\n";
3030
close FILE;
3131

@@ -34,15 +34,16 @@ sub cb {
3434

3535
my $callback = Win32::API::Callback->new(\&cb, "L", "L");
3636

37-
SetConsoleCtrlHandler($callback, 1) # add handler
38-
or die "Error: " . GetLastError() . "\n";
37+
SetConsoleCtrlHandler($callback, 1) # add handler
38+
or die "Error: " . GetLastError() . "\n";
3939
END { unlink "QUIT.TXT"; }
4040

4141
diag("callback installed, sleep 1, generate Ctrl-C signal");
4242
sleep(1);
43+
4344
#GenerateConsoleCtrlEvent(0, 0); # generate the Ctrl-C signal
44-
GenerateConsoleCtrlEvent(1, 0); # generate the Ctrl-Break signal
45+
GenerateConsoleCtrlEvent(1, 0); # generate the Ctrl-Break signal
4546
diag("callback called or not");
4647
sleep(2);
47-
ok (-f "QUIT.TXT", "QUIT.TXT exists, ctrl-c signalhandler called");
48-
SetConsoleCtrlHandler($callback, 0); # remove handler
48+
ok(-f "QUIT.TXT", "QUIT.TXT exists, ctrl-c signalhandler called");
49+
SetConsoleCtrlHandler($callback, 0); # remove handler

0 commit comments

Comments
 (0)