ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Strict.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Strict.pm (file contents):
Revision 1.1 by root, Tue Jul 8 23:53:37 2008 UTC vs.
Revision 1.14 by root, Thu Jul 9 18:58:19 2009 UTC

1=head1 NAME
2
3AnyEvent::Strict - force strict mode on for the whole process
4
5=head1 SYNOPSIS
6
7 use AnyEvent::Strict;
8 # strict mode now switched on
9
10=head1 DESCRIPTION
11
12This module implements AnyEvent's strict mode.
13
14Loading it makes AnyEvent check all arguments to AnyEvent-methods, at the
15expense of being slower (often the argument checking takes longer than the
16actual function).
17
18Normally, you don't load this module yourself but instead use it
19indirectly via the C<PERL_ANYEVENT_STRICT> environment variable (see
20L<AnyEvent>). However, this module can be loaded at any time.
21
22=cut
23
1package AnyEvent::Strict; 24package AnyEvent::Strict;
2 25
26use common::sense;
27
3use Carp qw(croak); 28use Carp qw(croak);
29use Fcntl ();
30
4use AnyEvent (); 31use AnyEvent ();
5 32
33our @ISA;
34
6AnyEvent::post_detect { 35AnyEvent::post_detect {
36 # assume the first ISA member is the implementation
37 # # and link us in before it in the chain.
7 my $MODEL = shift @AnyEvent::ISA; 38 my $MODEL = shift @AnyEvent::ISA;
8 unshift @ISA, $MODEL; 39 unshift @ISA, $MODEL;
9 unshift @AnyEvent::ISA, AnyEvent::Strict:: 40 unshift @AnyEvent::ISA, AnyEvent::Strict::
10}; 41};
11
12# supply checks for argument validity for many functions
13 42
14sub io { 43sub io {
15 my $class = shift; 44 my $class = shift;
16 my %arg = @_; 45 my %arg = @_;
17 46
18 ref $arg{cb} 47 ref $arg{cb}
19 or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'"; 48 or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'";
20 delete $arg{cb}; 49 delete $arg{cb};
21 50
22 fileno $arg{fh}
23 or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
24 delete $arg{fh};
25
26 $arg{poll} =~ /^[rw]$/ 51 $arg{poll} =~ /^[rw]$/
27 or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'"; 52 or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
53
54 if (defined fileno $arg{fh} or ref $arg{fh} or $arg{fh} !~ /^\s*\d+\s*$/) {
55 defined fileno $arg{fh}
56 or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
57 } else {
58 $arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh};
59 }
60
61 -f $arg{fh}
62 and croak "AnyEvent->io called with fh argument pointing to a file";
63
28 delete $arg{poll}; 64 delete $arg{poll};
65 delete $arg{fh};
29 66
30 croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg 67 croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
31 if keys %arg; 68 if keys %arg;
32 69
33 $class->SUPER::io (@_) 70 $class->SUPER::io (@_)
… …
61 98
62 ref $arg{cb} 99 ref $arg{cb}
63 or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'"; 100 or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
64 delete $arg{cb}; 101 delete $arg{cb};
65 102
66 eval "require POSIX; defined &POSIX::SIG$arg{signal}" 103 eval "require POSIX; 0 < &POSIX::SIG$arg{signal}"
67 or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'"; 104 or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
68 delete $arg{signal}; 105 delete $arg{signal};
69 106
70 croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg 107 croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
71 if keys %arg; 108 if keys %arg;
… …
76sub child { 113sub child {
77 my $class = shift; 114 my $class = shift;
78 my %arg = @_; 115 my %arg = @_;
79 116
80 ref $arg{cb} 117 ref $arg{cb}
81 or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'"; 118 or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
82 delete $arg{cb}; 119 delete $arg{cb};
83 120
84 $arg{pid} =~ /^-?\d+$/ 121 $arg{pid} =~ /^-?\d+$/
85 or croak "AnyEvent->signal called with illegal pid value '$arg{pid}'"; 122 or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
86 delete $arg{pid}; 123 delete $arg{pid};
87 124
88 croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg 125 croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
89 if keys %arg; 126 if keys %arg;
90 127
91 $class->SUPER::child (@_) 128 $class->SUPER::child (@_)
129}
130
131sub idle {
132 my $class = shift;
133 my %arg = @_;
134
135 ref $arg{cb}
136 or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
137 delete $arg{cb};
138
139 croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
140 if keys %arg;
141
142 $class->SUPER::idle (@_)
92} 143}
93 144
94sub condvar { 145sub condvar {
95 my $class = shift; 146 my $class = shift;
96 my %arg = @_; 147 my %arg = @_;
… …
121 and croak "AnyEvent->now wrongly called with paramaters"; 172 and croak "AnyEvent->now wrongly called with paramaters";
122 173
123 $class->SUPER::now (@_) 174 $class->SUPER::now (@_)
124} 175}
125 176
1261 1771;
178
179=head1 AUTHOR
180
181 Marc Lehmann <schmorp@schmorp.de>
182 http://home.schmorp.de/
183
184=cut
185

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines