lib/AnyEvent/Strict.pm

=head1 NAME

AnyEvent::Strict - force strict mode on for the whole process

=head1 SYNOPSIS

   use AnyEvent::Strict;
   # strict mode now switched on

=head1 DESCRIPTION

This module implements AnyEvent's strict mode.

Loading it makes AnyEvent check all arguments to AnyEvent-methods, at the
expense of being slower (often the argument checking takes longer than the
actual function).

B<< Currently, only AnyEvent I<methods> are checked, the AE:: I<functions> are not
affected. >>

Normally, you don't load this module yourself but instead use it
indirectly via the C<PERL_ANYEVENT_STRICT> environment variable (see
L<AnyEvent>). However, this module can be loaded manually at any time.

=cut

package AnyEvent::Strict;

use Carp qw(croak);

use AnyEvent (); BEGIN { AnyEvent::common_sense }

our @ISA;

AnyEvent::post_detect {
   # assume the first ISA member is the implementation
   # # and link us in before it in the chain.
   my $MODEL = shift @AnyEvent::ISA;
   unshift @ISA, $MODEL;
   unshift @AnyEvent::ISA, AnyEvent::Strict::;
   AE::_reset;
};

sub io {
   my $class = shift;
   my %arg = @_;

   ref $arg{cb}
      or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   $arg{poll} =~ /^[rw]$/
      or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";

   if ($arg{fh} =~ /^\s*\d+\s*$/) {
      $arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh};
   } else {
      defined eval { fileno $arg{fh} }
         or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
   }

   -f $arg{fh}
      and croak "AnyEvent->io called with fh argument pointing to a file";

   delete $arg{poll};
   delete $arg{fh};
 
   croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::io (@_)
}

sub timer {
   my $class = shift;
   my %arg = @_;

   ref $arg{cb}
      or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   exists $arg{after}
      or croak "AnyEvent->timer called without mandatory 'after' parameter";
   delete $arg{after};
 
   !$arg{interval} or $arg{interval} > 0
      or croak "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
   delete $arg{interval};
 
   croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::timer (@_)
}

sub signal {
   my $class = shift;
   my %arg = @_;

   ref $arg{cb}
      or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   defined AnyEvent::Base::sig2num $arg{signal} and $arg{signal} == 0
      or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
   delete $arg{signal};
 
   croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::signal (@_)
}

sub child {
   my $class = shift;
   my %arg = @_;

   ref $arg{cb}
      or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   $arg{pid} =~ /^-?\d+$/
      or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
   delete $arg{pid};
 
   croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::child (@_)
}

sub idle {
   my $class = shift;
   my %arg = @_;

   ref $arg{cb}
      or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::idle (@_)
}

sub condvar {
   my $class = shift;
   my %arg = @_;

   !exists $arg{cb} or ref $arg{cb}
      or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::condvar (@_)
}

sub time {
   my $class = shift;

   @_
      and croak "AnyEvent->time wrongly called with paramaters";

   $class->SUPER::time (@_)
}

sub now {
   my $class = shift;

   @_
      and croak "AnyEvent->now wrongly called with paramaters";

   $class->SUPER::now (@_)
}

1;

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.25
Committed:	Sat Aug 13 02:20:29 2011 UTC (12 years, 10 months ago) by root
Branch:	MAIN
CVS Tags:	rel-6_0
Changes since 1.24:	+1 -0 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.5	=head1 NAME
2
3			AnyEvent::Strict - force strict mode on for the whole process
4
5			=head1 SYNOPSIS
6
7			use AnyEvent::Strict;
8	root	1.8	# strict mode now switched on
9	root	1.5
10			=head1 DESCRIPTION
11
12			This module implements AnyEvent's strict mode.
13
14			Loading it makes AnyEvent check all arguments to AnyEvent-methods, at the
15			expense of being slower (often the argument checking takes longer than the
16	root	1.7	actual function).
17	root	1.5
18	root	1.23	B<< Currently, only AnyEvent I<methods> are checked, the AE:: I<functions> are not
19			affected. >>
20
21	root	1.5	Normally, you don't load this module yourself but instead use it
22			indirectly via the C<PERL_ANYEVENT_STRICT> environment variable (see
23	root	1.24	L<AnyEvent>). However, this module can be loaded manually at any time.
24	root	1.5
25			=cut
26
27	root	1.1	package AnyEvent::Strict;
28
29	root	1.5	use Carp qw(croak);
30	root	1.2
31	root	1.17	use AnyEvent (); BEGIN { AnyEvent::common_sense }
32	root	1.1
33	root	1.13	our @ISA;
34
35	root	1.1	AnyEvent::post_detect {
36	root	1.3	# assume the first ISA member is the implementation
37			# # and link us in before it in the chain.
38	root	1.1	my $MODEL = shift @AnyEvent::ISA;
39			unshift @ISA, $MODEL;
40	root	1.22	unshift @AnyEvent::ISA, AnyEvent::Strict::;
41	root	1.25	AE::_reset;
42	root	1.1	};
43
44			sub io {
45			my $class = shift;
46			my %arg = @_;
47
48			ref $arg{cb}
49			or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'";
50			delete $arg{cb};
51
52	root	1.13	$arg{poll} =~ /^[rw]$/
53			or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
54
55	root	1.21	if ($arg{fh} =~ /^\s\d+\s$/) {
56			$arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh};
57			} else {
58			defined eval { fileno $arg{fh} }
59	root	1.13	or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
60			}
61
62	root	1.9	-f $arg{fh}
63			and croak "AnyEvent->io called with fh argument pointing to a file";
64	root	1.13
65			delete $arg{poll};
66	root	1.1	delete $arg{fh};
67
68			croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
69			if keys %arg;
70
71			$class->SUPER::io (@_)
72			}
73
74			sub timer {
75			my $class = shift;
76			my %arg = @_;
77
78			ref $arg{cb}
79			or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
80			delete $arg{cb};
81
82			exists $arg{after}
83			or croak "AnyEvent->timer called without mandatory 'after' parameter";
84			delete $arg{after};
85
86			!$arg{interval} or $arg{interval} > 0
87			or croak "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
88			delete $arg{interval};
89
90			croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
91			if keys %arg;
92
93			$class->SUPER::timer (@_)
94			}
95
96			sub signal {
97			my $class = shift;
98			my %arg = @_;
99
100			ref $arg{cb}
101			or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
102			delete $arg{cb};
103
104	root	1.19	defined AnyEvent::Base::sig2num $arg{signal} and $arg{signal} == 0
105	root	1.1	or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
106			delete $arg{signal};
107
108			croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
109			if keys %arg;
110
111			$class->SUPER::signal (@_)
112			}
113
114			sub child {
115			my $class = shift;
116			my %arg = @_;
117
118			ref $arg{cb}
119	root	1.11	or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
120	root	1.1	delete $arg{cb};
121
122			$arg{pid} =~ /^-?\d+$/
123	root	1.11	or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
124	root	1.1	delete $arg{pid};
125
126	root	1.11	croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
127	root	1.1	if keys %arg;
128
129			$class->SUPER::child (@_)
130			}
131
132	root	1.12	sub idle {
133			my $class = shift;
134			my %arg = @_;
135
136			ref $arg{cb}
137			or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
138			delete $arg{cb};
139
140			croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
141			if keys %arg;
142
143			$class->SUPER::idle (@_)
144			}
145
146	root	1.1	sub condvar {
147			my $class = shift;
148			my %arg = @_;
149
150			!exists $arg{cb} or ref $arg{cb}
151			or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
152			delete $arg{cb};
153
154			croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
155			if keys %arg;
156
157			$class->SUPER::condvar (@_)
158			}
159
160			sub time {
161			my $class = shift;
162
163			@_
164			and croak "AnyEvent->time wrongly called with paramaters";
165
166			$class->SUPER::time (@_)
167			}
168
169			sub now {
170			my $class = shift;
171
172			@_
173			and croak "AnyEvent->now wrongly called with paramaters";
174
175			$class->SUPER::now (@_)
176			}
177
178	root	1.5	1;
179
180			=head1 AUTHOR
181
182			Marc Lehmann <schmorp@schmorp.de>
183			http://home.schmorp.de/
184
185			=cut
186